Mercurial > emacs
annotate lisp/progmodes/ada-mode.el @ 20383:3a76b48c399d
1997-11-27 Richard Stallman <rms@sucrose.ai.mit.edu>
* dired.el (dired-move-to-filename-regexp): Make regexp fussier
about amount of whitespace after month name.
author | Joel N. Weber II <devnull@gnu.org> |
---|---|
date | Sat, 29 Nov 1997 05:21:18 +0000 |
parents | f7cc7a56414c |
children | 90f306f86f5d |
rev | line source |
---|---|
13337 | 1 ;;; ada-mode.el --- An Emacs major-mode for editing Ada source. |
17996 | 2 |
3 ;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc. | |
4 | |
5 ;; Authors: Rolf Ebert <ebert@inf.enst.fr> | |
6 ;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> | |
7 ;; Keywords: languages oop ada | |
18120 | 8 ;; Rolf Ebert's version: 2.27 |
17996 | 9 |
10 ;; This file is part of GNU Emacs. | |
10705 | 11 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
14169 | 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
10705 | 26 |
27 ;;; This mode is a complete rewrite of a major mode for editing Ada 83 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
28 ;;; and Ada 95 source code under Emacs-19. It contains completely new |
10705 | 29 ;;; indenting code and support for code browsing (see ada-xref). |
30 | |
31 | |
32 ;;; USAGE | |
33 ;;; ===== | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
34 ;;; Emacs should enter Ada mode when you load an Ada source (*.ad[abs]). |
10705 | 35 ;;; |
36 ;;; When you have entered ada-mode, you may get more info by pressing | |
37 ;;; C-h m. You may also get online help describing various functions by: | |
38 ;;; C-h d <Name of function you want described> | |
39 | |
40 | |
41 ;;; HISTORY | |
42 ;;; ======= | |
11199 | 43 ;;; The first Ada mode for GNU Emacs was written by V. Broman in |
44 ;;; 1985. He based his work on the already existing Modula-2 mode. | |
45 ;;; This was distributed as ada.el in versions of Emacs prior to 19.29. | |
10705 | 46 ;;; |
47 ;;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of | |
48 ;;; several files with support for dired commands and other nice | |
49 ;;; things. It is currently available from the PAL | |
50 ;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z. | |
51 ;;; | |
52 ;;; The probably very first Ada mode (called electric-ada.el) was | |
53 ;;; written by Steven D. Litvintchouk and Steven M. Rosen for the | |
54 ;;; Gosling Emacs. L. Slater based his development on ada.el and | |
55 ;;; electric-ada.el. | |
56 ;;; | |
57 ;;; The current Ada mode is a complete rewrite by M. Heritsch and | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
58 ;;; R. Ebert. Some ideas from the Ada mode mailing list have been |
10705 | 59 ;;; added. Some of the functionality of L. Slater's mode has not |
60 ;;; (yet) been recoded in this new mode. Perhaps you prefer sticking | |
61 ;;; to his version. | |
62 | |
63 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
64 ;;; KNOWN BUGS |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
65 ;;; ========== |
10705 | 66 ;;; |
67 ;;; In the presence of comments and/or incorrect syntax | |
68 ;;; ada-format-paramlist produces weird results. | |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
69 ;;; ------------------- |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
70 ;;; Character constants with otherwise syntactic relevant characters |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
71 ;;; like `(' or `"' throw indentation off the track. Fontification |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
72 ;;; should work now in Emacs-19.35 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
73 ;;; C : constant Character := Character'('"'); |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
74 ;;; ------------------- |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
75 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
76 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
77 ;;; TODO |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
78 ;;; ==== |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
79 ;;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
80 ;;; o bodify-single-subprogram |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
81 ;;; o make a function "separate" and put it in the corresponding file. |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
82 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
83 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
84 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
85 ;;; CREDITS |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
86 ;;; ======= |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
87 ;;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
88 ;;; Many thanks to |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
89 ;;; Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular, |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
90 ;;; woodruff@stc.llnl.gov (John Woodruff) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
91 ;;; jj@ddci.dk (Jesper Joergensen) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
92 ;;; gse@ocsystems.com (Scott Evans) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
93 ;;; comar@LANG8.CS.NYU.EDU (Cyrille Comar) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
94 ;;; and others for their valuable hints. |
10705 | 95 |
96 ;;;-------------------- | |
97 ;;; USER OPTIONS | |
98 ;;;-------------------- | |
99 | |
18120 | 100 |
101 ;; ---- customize support | |
102 | |
103 (defgroup ada nil | |
104 "Major mode for editing Ada source in Emacs" | |
105 :group 'languages) | |
106 | |
10705 | 107 ;; ---- configure indentation |
108 | |
18120 | 109 (defcustom ada-indent 3 |
110 "*Defines the size of Ada indentation." | |
111 :type 'integer | |
112 :group 'ada) | |
113 | |
114 (defcustom ada-broken-indent 2 | |
115 "*# of columns to indent the continuation of a broken line." | |
116 :type 'integer | |
117 :group 'ada) | |
118 | |
119 (defcustom ada-label-indent -4 | |
120 "*# of columns to indent a label." | |
121 :type 'integer | |
122 :group 'ada) | |
123 | |
124 (defcustom ada-stmt-end-indent 0 | |
10705 | 125 "*# of columns to indent a statement end keyword in a separate line. |
18120 | 126 Examples are 'is', 'loop', 'record', ..." |
127 :type 'integer | |
128 :group 'ada) | |
129 | |
130 (defcustom ada-when-indent 3 | |
131 "*Defines the indentation for 'when' relative to 'exception' or 'case'." | |
132 :type 'integer | |
133 :group 'ada) | |
134 | |
135 (defcustom ada-indent-record-rel-type 3 | |
136 "*Defines the indentation for 'record' relative to 'type' or 'use'." | |
137 :type 'integer | |
138 :group 'ada) | |
139 | |
140 (defcustom ada-indent-comment-as-code t | |
141 "*If non-nil, comment-lines get indented as Ada code." | |
142 :type 'boolean | |
143 :group 'ada) | |
144 | |
145 (defcustom ada-indent-is-separate t | |
146 "*If non-nil, 'is separate' or 'is abstract' on a single line are indented." | |
147 :type 'boolean | |
148 :group 'ada) | |
149 | |
150 (defcustom ada-indent-to-open-paren t | |
151 "*If non-nil, indent according to the innermost open parenthesis." | |
152 :type 'boolean | |
153 :group 'ada) | |
154 | |
155 (defcustom ada-search-paren-char-count-limit 3000 | |
156 "*Search that many characters for an open parenthesis." | |
157 :type 'integer | |
158 :group 'ada) | |
10705 | 159 |
160 | |
161 ;; ---- other user options | |
162 | |
18120 | 163 (defcustom ada-tab-policy 'indent-auto |
10705 | 164 "*Control behaviour of the TAB key. |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
165 Must be one of `indent-rigidly', `indent-auto', `gei', `indent-af' |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
166 or `always-tab'. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
167 |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
168 `indent-rigidly' : always adds ada-indent blanks at the beginning of the line. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
169 `indent-auto' : use indentation functions in this file. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
170 `gei' : use David Kågedal's Generic Indentation Engine. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
171 `indent-af' : use Gary E. Barnes' ada-format.el |
18120 | 172 `always-tab' : do indent-relative." |
173 :type '(choice (const indent-auto) | |
174 (const indent-rigidly) | |
175 (const gei) | |
176 (const indent-af) | |
177 (const always-tab)) | |
178 :group 'ada) | |
179 | |
180 (defcustom ada-move-to-declaration nil | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
181 "*If non-nil, `ada-move-to-start' moves point to the subprog declaration, |
18120 | 182 not to 'begin'." |
183 :type 'boolean | |
184 :group 'ada) | |
185 | |
186 (defcustom ada-spec-suffix ".ads" | |
187 "*Suffix of Ada specification files." | |
188 :type 'string | |
189 :group 'ada) | |
190 | |
191 (defcustom ada-body-suffix ".adb" | |
192 "*Suffix of Ada body files." | |
193 :type 'string | |
194 :group 'ada) | |
195 | |
196 (defcustom ada-spec-suffix-as-regexp "\\.ads$" | |
197 "*Regexp to find Ada specification files." | |
198 :type 'string | |
199 :group 'ada) | |
200 | |
201 (defcustom ada-body-suffix-as-regexp "\\.adb$" | |
202 "*Regexp to find Ada body files." | |
203 :type 'string | |
204 :group 'ada) | |
205 | |
206 (defvar ada-other-file-alist | |
207 (list | |
208 (list ada-spec-suffix-as-regexp (list ada-body-suffix)) | |
209 (list ada-body-suffix-as-regexp (list ada-spec-suffix)) | |
210 ) | |
211 "*Alist of extensions to find given the current file's extension. | |
212 | |
213 This list should contain the most used extensions before the others, | |
214 since the search algorithm searches sequentially through each directory | |
215 specified in `ada-search-directories'. If a file is not found, a new one | |
216 is created with the first matching extension (`.adb' yields `.ads').") | |
217 | |
218 (defcustom ada-search-directories | |
219 '("." "/usr/adainclude" "/usr/local/adainclude" "/opt/gnu/adainclude") | |
220 "*List of directories to search for Ada files. | |
221 See the description for the `ff-search-directories' variable." | |
222 :type '(repeat (choice :tag "Directory" | |
223 (const :tag "default" nil) | |
224 (directory :format "%v"))) | |
225 :group 'ada) | |
226 | |
227 (defcustom ada-language-version 'ada95 | |
228 "*Do we program in `ada83' or `ada95'?" | |
229 :type '(choice (const ada83) | |
230 (const ada95)) | |
231 :group 'ada) | |
232 | |
233 (defcustom ada-case-keyword 'downcase-word | |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
234 "*Function to call to adjust the case of Ada keywords. |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
235 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or |
18120 | 236 `capitalize-word'." |
237 :type '(choice (const downcase-word) | |
238 (const upcase-word) | |
239 (const capitalize-word) | |
240 (const ada-loose-case-word)) | |
241 :group 'ada) | |
242 | |
243 (defcustom ada-case-identifier 'ada-loose-case-word | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
244 "*Function to call to adjust the case of an Ada identifier. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
245 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or |
18120 | 246 `capitalize-word'." |
247 :type '(choice (const downcase-word) | |
248 (const upcase-word) | |
249 (const capitalize-word) | |
250 (const ada-loose-case-word)) | |
251 :group 'ada) | |
252 | |
253 (defcustom ada-case-attribute 'capitalize-word | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
254 "*Function to call to adjust the case of Ada attributes. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
255 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or |
18120 | 256 `capitalize-word'." |
257 :type '(choice (const downcase-word) | |
258 (const upcase-word) | |
259 (const capitalize-word) | |
260 (const ada-loose-case-word)) | |
261 :group 'ada) | |
262 | |
263 (defcustom ada-auto-case t | |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
264 "*Non-nil automatically changes case of preceding word while typing. |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
265 Casing is done according to `ada-case-keyword', `ada-case-identifier' |
18120 | 266 and `ada-case-attribute'." |
267 :type 'boolean | |
268 :group 'ada) | |
269 | |
270 (defcustom ada-clean-buffer-before-saving t | |
271 "*If non-nil, `remove-trailing-spaces' and `untabify' buffer before saving." | |
272 :type 'boolean | |
273 :group 'ada) | |
10705 | 274 |
275 (defvar ada-mode-hook nil | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
276 "*List of functions to call when Ada mode is invoked. |
10705 | 277 This is a good place to add Ada environment specific bindings.") |
278 | |
18120 | 279 (defcustom ada-external-pretty-print-program "aimap" |
280 "*External pretty printer to call from within Ada mode." | |
281 :type 'string | |
282 :group 'ada) | |
283 | |
284 (defcustom ada-tmp-directory "/tmp/" | |
285 "*Directory to store the temporary file for the Ada pretty printer." | |
286 :type 'string | |
287 :group 'ada) | |
288 | |
289 (defcustom ada-compile-options "-c" | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
290 "*Buffer local options passed to the Ada compiler. |
18120 | 291 These options are used when the compiler is invoked on the current buffer." |
292 :type 'string | |
293 :group 'ada) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
294 (make-variable-buffer-local 'ada-compile-options) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
295 |
18120 | 296 (defcustom ada-make-options "-c" |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
297 "*Buffer local options passed to `ada-compiler-make' (usually `gnatmake'). |
18120 | 298 These options are used when `gnatmake' is invoked on the current buffer." |
299 :type 'string | |
300 :group 'ada) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
301 (make-variable-buffer-local 'ada-make-options) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
302 |
18120 | 303 (defcustom ada-compiler-syntax-check "gcc -c -gnats" |
304 "*Compiler command with options for syntax checking." | |
305 :type 'string | |
306 :group 'ada) | |
307 | |
308 (defcustom ada-compiler-make "gnatmake" | |
309 "*The `make' command for the given compiler." | |
310 :type 'string | |
311 :group 'ada) | |
312 | |
313 (defcustom ada-fill-comment-prefix "-- " | |
314 "*This is inserted in the first columns when filling a comment paragraph." | |
315 :type 'string | |
316 :group 'ada) | |
317 | |
318 (defcustom ada-fill-comment-postfix " --" | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
319 "*This is inserted at the end of each line when filling a comment paragraph. |
18120 | 320 with `ada-fill-comment-paragraph-postfix'." |
321 :type 'string | |
322 :group 'ada) | |
323 | |
324 (defcustom ada-krunch-args "0" | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
325 "*Argument of gnatkr, a string containing the max number of characters. |
18120 | 326 Set to 0, if you don't use crunched filenames." |
327 :type 'string | |
328 :group 'ada) | |
10705 | 329 |
330 ;;; ---- end of user configurable variables | |
331 | |
332 | |
333 (defvar ada-mode-abbrev-table nil | |
334 "Abbrev table used in Ada mode.") | |
335 (define-abbrev-table 'ada-mode-abbrev-table ()) | |
336 | |
337 (defvar ada-mode-map () | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
338 "Local keymap used for Ada mode.") |
10705 | 339 |
340 (defvar ada-mode-syntax-table nil | |
341 "Syntax table to be used for editing Ada source code.") | |
342 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
343 (defvar ada-mode-symbol-syntax-table nil |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
344 "Syntax table for Ada, where `_' is a word constituent.") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
345 |
10705 | 346 (defconst ada-83-keywords |
347 "\\<\\(abort\\|abs\\|accept\\|access\\|all\\|and\\|array\\|\ | |
348 at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|\ | |
349 digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|\ | |
350 function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|\ | |
351 new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|\ | |
352 private\\|procedure\\|raise\\|range\\|record\\|rem\\|renames\\|\ | |
353 return\\|reverse\\|select\\|separate\\|subtype\\|task\\|terminate\\|\ | |
354 then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>" | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
355 ; "\\<\\(a\\(b\\(ort\\|s\\)\\|cce\\(pt\\|ss\\)\\|ll\\|nd\\|rray\\|t\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
356 ;b\\(egin\\|ody\\)\\|c\\(ase\\|onstant\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
357 ;d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
358 ;e\\(ls\\(e\\|if\\)\\|n\\(d\\|try\\)\\|x\\(ception\\|it\\)\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
359 ;f\\(or\\|unction\\)\\|g\\(eneric\\|oto\\)\\|i[fns]\\|l\\(imited\\|oop\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
360 ;mod\\|n\\(ew\\|ot\\|ull\\)\\|o\\([fr]\\|thers\\|ut\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
361 ;p\\(ackage\\|r\\(agma\\|ivate\\|ocedure\\)\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
362 ;r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|turn\\|verse\\)\\)\\|\ |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
363 ;s\\(e\\(lect\\|parate\\)\\|ubtype\\)\\|use\\| |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
364 ;t\\(ask\\|erminate\\|hen\\|ype\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|xor\\)\\>" |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
365 "Regular expression for looking at Ada83 keywords.") |
10705 | 366 |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
367 (defconst ada-95-keywords |
10705 | 368 "\\<\\(abort\\|abs\\|abstract\\|accept\\|access\\|aliased\\|\ |
369 all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|\ | |
370 delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|\ | |
371 exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|\ | |
372 is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|\ | |
373 out\\|package\\|pragma\\|private\\|procedure\\|protected\\|raise\\|\ | |
374 range\\|record\\|rem\\|renames\\|requeue\\|return\\|reverse\\|\ | |
375 select\\|separate\\|subtype\\|tagged\\|task\\|terminate\\|then\\|\ | |
376 type\\|until\\|use\\|when\\|while\\|with\\|xor\\)\\>" | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
377 "Regular expression for looking at Ada95 keywords.") |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
378 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
379 (defvar ada-keywords ada-95-keywords |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
380 "Regular expression for looking at Ada keywords.") |
10705 | 381 |
382 (defvar ada-ret-binding nil | |
383 "Variable to save key binding of RET when casing is activated.") | |
384 | |
385 (defvar ada-lfd-binding nil | |
386 "Variable to save key binding of LFD when casing is activated.") | |
387 | |
388 ;;; ---- Regexps to find procedures/functions/packages | |
389 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
390 (defconst ada-ident-re |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
391 "[a-zA-Z0-9_\\.]+" |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
392 "Regexp matching Ada (qualified) identifiers.") |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
393 |
10705 | 394 (defvar ada-procedure-start-regexp |
395 "^[ \t]*\\(procedure\\|function\\|task\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)" | |
396 "Regexp used to find Ada procedures/functions.") | |
397 | |
398 (defvar ada-package-start-regexp | |
399 "^[ \t]*\\(package\\)" | |
400 "Regexp used to find Ada packages") | |
401 | |
402 | |
403 ;;; ---- regexps for indentation functions | |
404 | |
405 (defvar ada-block-start-re | |
406 "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|\ | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
407 exception\\|loop\\|else\\|\ |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
408 \\(\\(limited\\|abstract\\|tagged\\)[ \t]+\\)*record\\)\\>" |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
409 "Regexp for keywords starting Ada blocks.") |
10705 | 410 |
411 (defvar ada-end-stmt-re | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
412 "\\(;\\|=>\\|^[ \t]*separate[ \t]+([a-zA-Z0-9_\\.]+)\\|\ |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
413 \\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|then\\|\ |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
414 declare\\|generic\\|private\\)\\>\\|\ |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
415 ^[ \t]*\\(package\\|procedure\\|function\\)\\>[ \ta-zA-Z0-9_\\.]+\\<is\\>\\|\ |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
416 ^[ \t]*exception\\>\\)" |
10705 | 417 "Regexp of possible ends for a non-broken statement. |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
418 A new statement starts after these.") |
10705 | 419 |
420 (defvar ada-loop-start-re | |
421 "\\<\\(for\\|while\\|loop\\)\\>" | |
422 "Regexp for the start of a loop.") | |
423 | |
424 (defvar ada-subprog-start-re | |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
425 "\\<\\(procedure\\|protected\\|package\\|function\\|\ |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
426 task\\|accept\\|entry\\)\\>" |
10705 | 427 "Regexp for the start of a subprogram.") |
428 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
429 (defvar ada-named-block-re |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
430 "[ \t]*[a-zA-Z_0-9]+ *:[^=]" |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
431 "Regexp of the name of a block or loop.") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
432 |
10705 | 433 |
12702
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
434 ;; Written by Christian Egli <Christian.Egli@hcsd.hac.com> |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
435 ;; |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
436 (defvar ada-imenu-generic-expression |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
437 '((nil "^\\s-*\\(procedure\\|function\\)\\s-+\\([A-Za-z0-9_]+\\)" 2) |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
438 ("Type Defs" "^\\s-*\\(sub\\)?type\\s-+\\([A-Za-z0-9_]+\\)" 2)) |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
439 |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
440 "Imenu generic expression for Ada mode. See `imenu-generic-expression'.") |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
441 |
10705 | 442 ;;;------------- |
443 ;;; functions | |
444 ;;;------------- | |
445 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
446 (defun ada-xemacs () |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
447 (or (string-match "Lucid" emacs-version) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
448 (string-match "XEmacs" emacs-version))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
449 |
10705 | 450 (defun ada-create-syntax-table () |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
451 "Create the syntax table for Ada mode." |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
452 ;; There are two different syntax-tables. The standard one declares |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
453 ;; `_' as a symbol constituent, in the second one, it is a word |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
454 ;; constituent. For some search and replacing routines we |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
455 ;; temporarily switch between the two. |
10705 | 456 (setq ada-mode-syntax-table (make-syntax-table)) |
457 (set-syntax-table ada-mode-syntax-table) | |
458 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
459 ;; define string brackets (`%' is alternative string bracket, but |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
460 ;; almost never used as such and throws font-lock and indentation |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
461 ;; off the track.) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
462 (modify-syntax-entry ?% "$" ada-mode-syntax-table) |
10705 | 463 (modify-syntax-entry ?\" "\"" ada-mode-syntax-table) |
464 | |
465 (modify-syntax-entry ?\# "$" ada-mode-syntax-table) | |
466 | |
467 (modify-syntax-entry ?: "." ada-mode-syntax-table) | |
468 (modify-syntax-entry ?\; "." ada-mode-syntax-table) | |
469 (modify-syntax-entry ?& "." ada-mode-syntax-table) | |
470 (modify-syntax-entry ?\| "." ada-mode-syntax-table) | |
471 (modify-syntax-entry ?+ "." ada-mode-syntax-table) | |
472 (modify-syntax-entry ?* "." ada-mode-syntax-table) | |
473 (modify-syntax-entry ?/ "." ada-mode-syntax-table) | |
474 (modify-syntax-entry ?= "." ada-mode-syntax-table) | |
475 (modify-syntax-entry ?< "." ada-mode-syntax-table) | |
476 (modify-syntax-entry ?> "." ada-mode-syntax-table) | |
477 (modify-syntax-entry ?$ "." ada-mode-syntax-table) | |
478 (modify-syntax-entry ?\[ "." ada-mode-syntax-table) | |
479 (modify-syntax-entry ?\] "." ada-mode-syntax-table) | |
480 (modify-syntax-entry ?\{ "." ada-mode-syntax-table) | |
481 (modify-syntax-entry ?\} "." ada-mode-syntax-table) | |
482 (modify-syntax-entry ?. "." ada-mode-syntax-table) | |
483 (modify-syntax-entry ?\\ "." ada-mode-syntax-table) | |
484 (modify-syntax-entry ?\' "." ada-mode-syntax-table) | |
485 | |
486 ;; a single hyphen is punctuation, but a double hyphen starts a comment | |
487 (modify-syntax-entry ?- ". 12" ada-mode-syntax-table) | |
488 | |
489 ;; and \f and \n end a comment | |
490 (modify-syntax-entry ?\f "> " ada-mode-syntax-table) | |
491 (modify-syntax-entry ?\n "> " ada-mode-syntax-table) | |
492 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
493 ;; define what belongs in Ada symbols |
10705 | 494 (modify-syntax-entry ?_ "_" ada-mode-syntax-table) |
495 | |
496 ;; define parentheses to match | |
497 (modify-syntax-entry ?\( "()" ada-mode-syntax-table) | |
498 (modify-syntax-entry ?\) ")(" ada-mode-syntax-table) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
499 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
500 (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
501 (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table) |
10705 | 502 ) |
503 | |
504 | |
10707 | 505 ;;;###autoload |
10705 | 506 (defun ada-mode () |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
507 "Ada mode is the major mode for editing Ada code. |
10705 | 508 |
509 Bindings are as follows: (Note: 'LFD' is control-j.) | |
510 | |
511 Indent line '\\[ada-tab]' | |
512 Indent line, insert newline and indent the new line. '\\[newline-and-indent]' | |
513 | |
514 Re-format the parameter-list point is in '\\[ada-format-paramlist]' | |
515 Indent all lines in region '\\[ada-indent-region]' | |
516 Call external pretty printer program '\\[ada-call-pretty-printer]' | |
517 | |
518 Adjust case of identifiers and keywords in region '\\[ada-adjust-case-region]' | |
519 Adjust case of identifiers and keywords in buffer '\\[ada-adjust-case-buffer]' | |
520 | |
521 Call EXTERNAL pretty printer (if you have one) '\\[ada-call-pretty-printer]' | |
522 | |
523 Fill comment paragraph '\\[ada-fill-comment-paragraph]' | |
524 Fill comment paragraph and justify each line '\\[ada-fill-comment-paragraph-justify]' | |
525 Fill comment paragraph, justify and append postfix '\\[ada-fill-comment-paragraph-postfix]' | |
526 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
527 Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
528 Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]' |
10705 | 529 |
530 Goto matching start of current 'end ...;' '\\[ada-move-to-start]' | |
531 Goto end of current block '\\[ada-move-to-end]' | |
532 | |
533 Comments are handled using standard GNU Emacs conventions, including: | |
534 Start a comment '\\[indent-for-comment]' | |
535 Comment region '\\[comment-region]' | |
536 Uncomment region '\\[ada-uncomment-region]' | |
537 Continue comment on next line '\\[indent-new-comment-line]' | |
538 | |
539 If you use imenu.el: | |
540 Display index-menu of functions & procedures '\\[imenu]' | |
541 | |
542 If you use find-file.el: | |
543 Switch to other file (Body <-> Spec) '\\[ff-find-other-file]' | |
544 or '\\[ff-mouse-find-other-file] | |
545 Switch to other file in other window '\\[ada-ff-other-window]' | |
546 or '\\[ff-mouse-find-other-file-other-window] | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
547 If you use this function in a spec and no body is available, it gets created |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
548 with body stubs. |
10705 | 549 |
550 If you use ada-xref.el: | |
551 Goto declaration: '\\[ada-point-and-xref]' on the identifier | |
552 or '\\[ada-goto-declaration]' with point on the identifier | |
553 Complete identifier: '\\[ada-complete-identifier]' | |
554 Execute Gnatf: '\\[ada-gnatf-current]'" | |
555 | |
556 (interactive) | |
557 (kill-all-local-variables) | |
558 | |
559 (make-local-variable 'require-final-newline) | |
560 (setq require-final-newline t) | |
561 | |
562 (make-local-variable 'comment-start) | |
563 (setq comment-start "-- ") | |
564 | |
565 ;; comment end must be set because it may hold a wrong value if | |
566 ;; this buffer had been in another mode before. RE | |
567 (make-local-variable 'comment-end) | |
568 (setq comment-end "") | |
569 | |
570 (make-local-variable 'comment-start-skip) ;; used by autofill | |
571 (setq comment-start-skip "--+[ \t]*") | |
572 | |
573 (make-local-variable 'indent-line-function) | |
574 (setq indent-line-function 'ada-indent-current-function) | |
575 | |
576 (make-local-variable 'fill-column) | |
577 (setq fill-column 75) | |
578 | |
579 (make-local-variable 'comment-column) | |
580 (setq comment-column 40) | |
581 | |
582 (make-local-variable 'parse-sexp-ignore-comments) | |
583 (setq parse-sexp-ignore-comments t) | |
584 | |
585 (make-local-variable 'case-fold-search) | |
586 (setq case-fold-search t) | |
587 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
588 (make-local-variable 'outline-regexp) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
589 (setq outline-regexp "[^\n\^M]") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
590 (make-local-variable 'outline-level) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
591 (setq outline-level 'ada-outline-level) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
592 |
10707 | 593 (make-local-variable 'fill-paragraph-function) |
594 (setq fill-paragraph-function 'ada-fill-comment-paragraph) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
595 ;;(make-local-variable 'adaptive-fill-regexp) |
10707 | 596 |
12702
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
597 (make-local-variable 'imenu-generic-expression) |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
598 (setq imenu-generic-expression ada-imenu-generic-expression) |
b0355a012c1d
(ada-imenu-generic-expression): Var defined.
Karl Heuer <kwzh@gnu.org>
parents:
12586
diff
changeset
|
599 |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
600 (if (ada-xemacs) nil ; XEmacs uses properties |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
601 (make-local-variable 'font-lock-defaults) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
602 (setq font-lock-defaults |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
603 '((ada-font-lock-keywords |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
604 ada-font-lock-keywords-1 ada-font-lock-keywords-2) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
605 nil t |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
606 ((?\_ . "w")(?\. . "w")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
607 beginning-of-line |
18126
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
608 (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords))) |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
609 |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
610 ;; Set up support for find-file.el. |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
611 (make-variable-buffer-local 'ff-other-file-alist) |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
612 (make-variable-buffer-local 'ff-search-directories) |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
613 (setq ff-other-file-alist 'ada-other-file-alist |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
614 ff-search-directories 'ada-search-directories |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
615 ff-pre-load-hooks 'ff-which-function-are-we-in |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
616 ff-post-load-hooks 'ff-set-point-accordingly |
f7cc7a56414c
Finish installing previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18120
diff
changeset
|
617 ff-file-created-hooks 'ada-make-body)) |
10705 | 618 |
619 (setq major-mode 'ada-mode) | |
620 (setq mode-name "Ada") | |
621 | |
622 (use-local-map ada-mode-map) | |
623 | |
624 (if ada-mode-syntax-table | |
625 (set-syntax-table ada-mode-syntax-table) | |
626 (ada-create-syntax-table)) | |
627 | |
628 (if ada-clean-buffer-before-saving | |
629 (progn | |
630 ;; remove all spaces at the end of lines in the whole buffer. | |
631 (add-hook 'local-write-file-hooks 'ada-remove-trailing-spaces) | |
632 ;; convert all tabs to the correct number of spaces. | |
633 (add-hook 'local-write-file-hooks 'ada-untabify-buffer))) | |
634 | |
635 | |
636 ;; add menu 'Ada' to the menu bar | |
637 (ada-add-ada-menu) | |
638 | |
639 (run-hooks 'ada-mode-hook) | |
640 | |
641 ;; the following has to be done after running the ada-mode-hook | |
642 ;; because users might want to set the values of these variable | |
643 ;; inside the hook (MH) | |
644 | |
645 (cond ((eq ada-language-version 'ada83) | |
646 (setq ada-keywords ada-83-keywords)) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
647 ((eq ada-language-version 'ada95) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
648 (setq ada-keywords ada-95-keywords))) |
10705 | 649 |
650 (if ada-auto-case | |
651 (ada-activate-keys-for-case))) | |
652 | |
653 | |
654 ;;;-------------------------- | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
655 ;;; Compile support |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
656 ;;;-------------------------- |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
657 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
658 (defun ada-check-syntax () |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
659 "Check syntax of the current buffer. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
660 Uses the function `compile' to execute `ada-compiler-syntax-check'." |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
661 (interactive) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
662 (let ((old-compile-command compile-command)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
663 (setq compile-command (concat ada-compiler-syntax-check |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
664 (if (eq ada-language-version 'ada83) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
665 "-gnat83 ") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
666 " " ada-compile-options " " |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
667 (buffer-name))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
668 (setq compile-command (read-from-minibuffer |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
669 "enter command for syntax check: " |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
670 compile-command)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
671 (compile compile-command) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
672 ;; restore old compile-command |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
673 (setq compile-command old-compile-command))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
674 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
675 (defun ada-make-local () |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
676 "Bring current Ada unit up-to-date. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
677 Uses the function `compile' to execute `ada-compile-make'." |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
678 (interactive) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
679 (let ((old-compile-command compile-command)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
680 (setq compile-command (concat ada-compiler-make |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
681 " " ada-make-options " " |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
682 (buffer-name))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
683 (setq compile-command (read-from-minibuffer |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
684 "enter command for local make: " |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
685 compile-command)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
686 (compile compile-command) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
687 ;; restore old compile-command |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
688 (setq compile-command old-compile-command))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
689 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
690 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
691 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
692 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
693 ;;;-------------------------- |
10705 | 694 ;;; Fill Comment Paragraph |
695 ;;;-------------------------- | |
696 | |
697 (defun ada-fill-comment-paragraph-justify () | |
698 "Fills current comment paragraph and justifies each line as well." | |
699 (interactive) | |
700 (ada-fill-comment-paragraph t)) | |
701 | |
702 | |
703 (defun ada-fill-comment-paragraph-postfix () | |
704 "Fills current comment paragraph and justifies each line as well. | |
705 Prompts for a postfix to be appended to each line." | |
706 (interactive) | |
707 (ada-fill-comment-paragraph t t)) | |
708 | |
709 | |
710 (defun ada-fill-comment-paragraph (&optional justify postfix) | |
711 "Fills the current comment paragraph. | |
712 If JUSTIFY is non-nil, each line is justified as well. | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
713 If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended |
10705 | 714 to each filled and justified line. |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
715 If `ada-indent-comment-as-code' is non-nil, the paragraph is idented." |
10705 | 716 (interactive "P") |
717 (let ((opos (point-marker)) | |
718 (begin nil) | |
719 (end nil) | |
720 (end-2 nil) | |
721 (indent nil) | |
722 (ada-fill-comment-old-postfix "") | |
723 (fill-prefix nil)) | |
724 | |
725 ;; check if inside comment | |
726 (if (not (ada-in-comment-p)) | |
727 (error "not inside comment")) | |
728 | |
729 ;; prompt for postfix if wanted | |
730 (if (and justify | |
731 postfix) | |
732 (setq ada-fill-comment-postfix | |
733 (read-from-minibuffer "enter new postfix string: " | |
734 ada-fill-comment-postfix))) | |
735 | |
736 ;; prompt for old postfix to remove if necessary | |
737 (if (and justify | |
738 postfix) | |
739 (setq ada-fill-comment-old-postfix | |
740 (read-from-minibuffer "enter already existing postfix string: " | |
741 ada-fill-comment-postfix))) | |
742 | |
743 ;; | |
744 ;; find limits of paragraph | |
745 ;; | |
746 (message "filling comment paragraph ...") | |
747 (save-excursion | |
748 (back-to-indentation) | |
749 ;; find end of paragraph | |
750 (while (and (looking-at "--.*$") | |
751 (not (looking-at "--[ \t]*$"))) | |
752 (forward-line 1) | |
753 (back-to-indentation)) | |
754 (beginning-of-line) | |
755 (setq end (point-marker)) | |
756 (goto-char opos) | |
757 ;; find begin of paragraph | |
758 (back-to-indentation) | |
759 (while (and (looking-at "--.*$") | |
760 (not (looking-at "--[ \t]*$"))) | |
761 (forward-line -1) | |
762 (back-to-indentation)) | |
763 (forward-line 1) | |
764 ;; get indentation to calculate width for filling | |
765 (ada-indent-current) | |
766 (back-to-indentation) | |
767 (setq indent (current-column)) | |
768 (setq begin (point-marker))) | |
769 | |
770 ;; delete old postfix if necessary | |
771 (if (and justify | |
772 postfix) | |
773 (save-excursion | |
774 (goto-char begin) | |
775 (while (re-search-forward (concat ada-fill-comment-old-postfix | |
776 "\n") | |
777 end t) | |
778 (replace-match "\n")))) | |
779 | |
780 ;; delete leading whitespace and uncomment | |
781 (save-excursion | |
782 (goto-char begin) | |
783 (beginning-of-line) | |
784 (while (re-search-forward "^[ \t]*--[ \t]*" end t) | |
785 (replace-match ""))) | |
786 | |
787 ;; calculate fill width | |
788 (setq fill-column (- fill-column indent | |
789 (length ada-fill-comment-prefix) | |
790 (if postfix | |
791 (length ada-fill-comment-postfix) | |
792 0))) | |
793 ;; fill paragraph | |
794 (fill-region begin (1- end) justify) | |
795 (setq fill-column (+ fill-column indent | |
796 (length ada-fill-comment-prefix) | |
797 (if postfix | |
798 (length ada-fill-comment-postfix) | |
799 0))) | |
800 ;; find end of second last line | |
801 (save-excursion | |
802 (goto-char end) | |
803 (forward-line -2) | |
804 (end-of-line) | |
805 (setq end-2 (point-marker))) | |
806 | |
807 ;; re-comment and re-indent region | |
808 (save-excursion | |
809 (goto-char begin) | |
810 (indent-to indent) | |
811 (insert ada-fill-comment-prefix) | |
812 (while (re-search-forward "\n" (1- end-2) t) | |
813 (replace-match (concat "\n" ada-fill-comment-prefix)) | |
814 (beginning-of-line) | |
815 (indent-to indent))) | |
816 | |
817 ;; append postfix if wanted | |
818 (if (and justify | |
819 postfix | |
820 ada-fill-comment-postfix) | |
821 (progn | |
822 ;; append postfix up to there | |
823 (save-excursion | |
824 (goto-char begin) | |
825 (while (re-search-forward "\n" (1- end-2) t) | |
826 (replace-match (concat ada-fill-comment-postfix "\n"))) | |
827 | |
828 ;; fill last line and append postfix | |
829 (end-of-line) | |
830 (insert-char ? | |
831 (- fill-column | |
832 (current-column) | |
833 (length ada-fill-comment-postfix))) | |
834 (insert ada-fill-comment-postfix)))) | |
835 | |
836 ;; delete the extra line that gets inserted somehow(??) | |
837 (save-excursion | |
838 (goto-char (1- end)) | |
839 (end-of-line) | |
840 (delete-char 1)) | |
841 | |
842 (message "filling comment paragraph ... done") | |
10707 | 843 (goto-char opos)) |
844 t) | |
10705 | 845 |
846 | |
847 ;;;--------------------------------;;; | |
848 ;;; Call External Pretty Printer ;;; | |
849 ;;;--------------------------------;;; | |
850 | |
851 (defun ada-call-pretty-printer () | |
852 "Calls the external Pretty Printer. | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
853 The name is specified in `ada-external-pretty-print-program'. Saves the |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
854 current buffer in a directory specified by `ada-tmp-directory', |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
855 starts the pretty printer as external process on that file and then |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
856 reloads the beautified program in the buffer and cleans up |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
857 `ada-tmp-directory'." |
10705 | 858 (interactive) |
859 (let ((filename-with-path buffer-file-name) | |
860 (curbuf (current-buffer)) | |
861 (orgpos (point)) | |
862 (mesgbuf nil) ;; for byte-compiling | |
863 (file-path (file-name-directory buffer-file-name)) | |
864 (filename-without-path (file-name-nondirectory buffer-file-name)) | |
865 (tmp-file-with-directory | |
866 (concat ada-tmp-directory | |
867 (file-name-nondirectory buffer-file-name)))) | |
868 ;; | |
869 ;; save buffer in temporary file | |
870 ;; | |
871 (message "saving current buffer to temporary file ...") | |
872 (write-file tmp-file-with-directory) | |
873 (auto-save-mode nil) | |
874 (message "saving current buffer to temporary file ... done") | |
875 ;; | |
876 ;; call external pretty printer program | |
877 ;; | |
878 | |
879 (message "running external pretty printer ...") | |
880 ;; create a temporary buffer for messages of pretty printer | |
881 (setq mesgbuf (get-buffer-create "Pretty Printer Messages")) | |
882 ;; execute pretty printer on temporary file | |
883 (call-process ada-external-pretty-print-program | |
884 nil mesgbuf t | |
885 tmp-file-with-directory) | |
886 ;; display messages if there are some | |
887 (if (buffer-modified-p mesgbuf) | |
888 ;; show the message buffer | |
889 (display-buffer mesgbuf t) | |
890 ;; kill the message buffer | |
891 (kill-buffer mesgbuf)) | |
892 (message "running external pretty printer ... done") | |
893 ;; | |
894 ;; kill current buffer and load pretty printer output | |
895 ;; or restore old buffer | |
896 ;; | |
897 (if (y-or-n-p | |
898 "Really replace current buffer with pretty printer output ? ") | |
899 (progn | |
900 (set-buffer-modified-p nil) | |
901 (kill-buffer curbuf) | |
902 (find-file tmp-file-with-directory)) | |
903 (message "old buffer contents restored")) | |
904 ;; | |
905 ;; delete temporary file and restore information of current buffer | |
906 ;; | |
907 (delete-file tmp-file-with-directory) | |
908 (set-visited-file-name filename-with-path) | |
909 (auto-save-mode t) | |
910 (goto-char orgpos))) | |
911 | |
912 | |
913 ;;;--------------- | |
914 ;;; auto-casing | |
915 ;;;--------------- | |
916 | |
917 ;; from Philippe Waroquiers <philippe@cfmu.eurocontrol.be> | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
918 ;; modified by RE and MH |
10705 | 919 |
920 (defun ada-after-keyword-p () | |
921 ;; returns t if cursor is after a keyword. | |
922 (save-excursion | |
923 (forward-word -1) | |
924 (and (save-excursion | |
925 (or | |
926 (= (point) (point-min)) | |
927 (backward-char 1)) | |
928 (not (looking-at "_"))) ; (MH) | |
929 (looking-at (concat ada-keywords "[^_]"))))) | |
930 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
931 (defun ada-in-char-const-p () |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
932 ;; Returns t if point is inside a character constant. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
933 ;; We assume to be in a constant if the previous and the next character |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
934 ;; are "'". |
10705 | 935 (save-excursion |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
936 (if (> (point) 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
937 (and |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
938 (progn |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
939 (forward-char 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
940 (looking-at "'")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
941 (progn |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
942 (forward-char -2) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
943 (looking-at "'"))) |
10705 | 944 nil))) |
945 | |
946 | |
947 (defun ada-adjust-case (&optional force-identifier) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
948 "Adjust the case of the word before the just typed character. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
949 Respect options `ada-case-keyword', `ada-case-identifier', and |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
950 `ada-case-attribute'. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
951 If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH) |
10705 | 952 (forward-char -1) |
953 (if (and (> (point) 1) (not (or (ada-in-string-p) | |
954 (ada-in-comment-p) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
955 (ada-in-char-const-p)))) |
10705 | 956 (if (eq (char-syntax (char-after (1- (point)))) ?w) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
957 (if (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
958 (forward-word -1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
959 (or (= (point) (point-min)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
960 (backward-char 1)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
961 (looking-at "'")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
962 (funcall ada-case-attribute -1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
963 (if (and |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
964 (not force-identifier) ; (MH) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
965 (ada-after-keyword-p)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
966 (funcall ada-case-keyword -1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
967 (funcall ada-case-identifier -1))))) |
10705 | 968 (forward-char 1)) |
969 | |
970 | |
971 (defun ada-adjust-case-interactive (arg) | |
972 (interactive "P") | |
973 (let ((lastk last-command-char)) | |
974 (cond ((or (eq lastk ?\n) | |
975 (eq lastk ?\r)) | |
976 ;; horrible kludge | |
977 (insert " ") | |
978 (ada-adjust-case) | |
979 ;; horrible dekludge | |
980 (delete-backward-char 1) | |
981 ;; some special keys and their bindings | |
982 (cond | |
983 ((eq lastk ?\n) | |
984 (funcall ada-lfd-binding)) | |
985 ((eq lastk ?\r) | |
986 (funcall ada-ret-binding)))) | |
987 ((eq lastk ?\C-i) (ada-tab)) | |
988 ((self-insert-command (prefix-numeric-value arg)))) | |
989 ;; if there is a keyword in front of the underscore | |
990 ;; then it should be part of an identifier (MH) | |
991 (if (eq lastk ?_) | |
992 (ada-adjust-case t) | |
993 (ada-adjust-case)))) | |
994 | |
995 | |
996 (defun ada-activate-keys-for-case () | |
997 ;; save original keybindings to allow swapping ret/lfd | |
998 ;; when casing is activated | |
999 ;; the 'or ...' is there to be sure that the value will not | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1000 ;; be changed again when Ada mode is called more than once (MH) |
10705 | 1001 (or ada-ret-binding |
1002 (setq ada-ret-binding (key-binding "\C-M"))) | |
1003 (or ada-lfd-binding | |
1004 (setq ada-lfd-binding (key-binding "\C-j"))) | |
1005 ;; call case modifying function after certain keys. | |
1006 (mapcar (function (lambda(key) (define-key | |
1007 ada-mode-map | |
1008 (char-to-string key) | |
1009 'ada-adjust-case-interactive))) | |
1010 '( ?` ?~ ?! ?@ ?# ?$ ?% ?^ ?& ?* ?( ?) ?- ?= ?+ ?[ ?{ ?] ?} | |
1011 ?_ ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r ))) | |
1012 ;; deleted ?\t from above list | |
1013 | |
1014 ;; | |
1015 ;; added by MH | |
1016 ;; | |
1017 (defun ada-loose-case-word (&optional arg) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1018 "Capitalizes the first letter and the letters following `_'. |
10705 | 1019 ARG is ignored, it's there to fit the standard casing functions' style." |
1020 (let ((pos (point)) | |
1021 (first t)) | |
1022 (skip-chars-backward "a-zA-Z0-9_") | |
1023 (while (or first | |
1024 (search-forward "_" pos t)) | |
1025 (and first | |
1026 (setq first nil)) | |
1027 (insert-char (upcase (following-char)) 1) | |
1028 (delete-char 1)) | |
1029 (goto-char pos))) | |
1030 | |
1031 | |
1032 ;; | |
1033 ;; added by MH | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1034 ;; modified by JSH to handle attributes |
10705 | 1035 ;; |
1036 (defun ada-adjust-case-region (from to) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1037 "Adjusts the case of all words in the region. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1038 Attention: This function might take very long for big regions !" |
10705 | 1039 (interactive "*r") |
1040 (let ((begin nil) | |
1041 (end nil) | |
1042 (keywordp nil) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1043 (attribp nil)) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1044 (unwind-protect |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1045 (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1046 (set-syntax-table ada-mode-symbol-syntax-table) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1047 (goto-char to) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1048 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1049 ;; loop: look for all identifiers, keywords, and attributes |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1050 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1051 (while (re-search-backward |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1052 "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]" |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1053 from |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1054 t) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1055 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1056 ;; print status message |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1057 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1058 (message "adjusting case ... %5d characters left" (- (point) from)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1059 (setq attribp (looking-at "'[a-zA-Z0-9_]+[^']")) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1060 (forward-char 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1061 (or |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1062 ;; do nothing if it is a string or comment |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1063 (ada-in-string-or-comment-p) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1064 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1065 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1066 ;; get the identifier or keyword or attribute |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1067 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1068 (setq begin (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1069 (setq keywordp (looking-at (concat ada-keywords "[^_]"))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1070 (skip-chars-forward "a-zA-Z0-9_") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1071 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1072 ;; casing according to user-option |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1073 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1074 (if keywordp |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1075 (funcall ada-case-keyword -1) |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1076 (if attribp |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1077 (funcall ada-case-attribute -1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1078 (funcall ada-case-identifier -1))) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1079 (goto-char begin)))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1080 (message "adjusting case ... done")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1081 (set-syntax-table ada-mode-syntax-table)))) |
10705 | 1082 |
1083 | |
1084 ;; | |
1085 ;; added by MH | |
1086 ;; | |
1087 (defun ada-adjust-case-buffer () | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1088 "Adjusts the case of all words in the whole buffer. |
10705 | 1089 ATTENTION: This function might take very long for big buffers !" |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1090 (interactive "*") |
10705 | 1091 (ada-adjust-case-region (point-min) (point-max))) |
1092 | |
1093 | |
1094 ;;;------------------------;;; | |
1095 ;;; Format Parameter Lists ;;; | |
1096 ;;;------------------------;;; | |
1097 | |
1098 (defun ada-format-paramlist () | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1099 "Reformats a parameter list. |
10705 | 1100 ATTENTION: 1) Comments inside the list are killed ! |
1101 2) If the syntax is not correct (especially, if there are | |
1102 semicolons missing), it can get totally confused ! | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1103 In such a case, use `undo', correct the syntax and try again." |
10705 | 1104 |
1105 (interactive) | |
1106 (let ((begin nil) | |
1107 (end nil) | |
1108 (delend nil) | |
1109 (paramlist nil)) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1110 (unwind-protect |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1111 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1112 (set-syntax-table ada-mode-symbol-syntax-table) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1113 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1114 ;; check if really inside parameter list |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1115 (or (ada-in-paramlist-p) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1116 (error "not in parameter list")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1117 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1118 ;; find start of current parameter-list |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1119 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1120 (ada-search-ignore-string-comment |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1121 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1122 (ada-search-ignore-string-comment "(" nil nil t) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1123 (backward-char 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1124 (setq begin (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1125 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1126 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1127 ;; find end of parameter-list |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1128 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1129 (forward-sexp 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1130 (setq delend (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1131 (delete-char -1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1132 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1133 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1134 ;; find end of last parameter-declaration |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1135 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1136 (ada-search-ignore-string-comment "[^ \t\n]" t nil t) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1137 (forward-char 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1138 (setq end (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1139 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1140 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1141 ;; build a list of all elements of the parameter-list |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1142 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1143 (setq paramlist (ada-scan-paramlist (1+ begin) end)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1144 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1145 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1146 ;; delete the original parameter-list |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1147 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1148 (delete-region begin (1- delend)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1149 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1150 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1151 ;; insert the new parameter-list |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1152 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1153 (goto-char begin) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1154 (ada-insert-paramlist paramlist)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1155 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1156 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1157 ;; restore syntax-table |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1158 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1159 (set-syntax-table ada-mode-syntax-table) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1160 ))) |
10705 | 1161 |
1162 | |
1163 (defun ada-scan-paramlist (begin end) | |
1164 ;; Scans a parameter-list between BEGIN and END and returns a list | |
1165 ;; of its contents. | |
1166 ;; The list has the following format: | |
1167 ;; | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1168 ;; Name of Param in? out? access? Name of Type Default-Exp or nil |
10705 | 1169 ;; |
1170 ;; ( ('Name_Param_1' t nil t Type_Param_1 ':= expression') | |
1171 ;; ('Name_Param_2' nil nil t Type_Param_2 nil) ) | |
1172 | |
1173 (let ((paramlist (list)) | |
1174 (param (list)) | |
1175 (notend t) | |
1176 (apos nil) | |
1177 (epos nil) | |
1178 (semipos nil) | |
1179 (match-cons nil)) | |
1180 | |
1181 (goto-char begin) | |
1182 ;; | |
1183 ;; loop until end of last parameter | |
1184 ;; | |
1185 (while notend | |
1186 | |
1187 ;; | |
1188 ;; find first character of parameter-declaration | |
1189 ;; | |
1190 (ada-goto-next-non-ws) | |
1191 (setq apos (point)) | |
1192 | |
1193 ;; | |
1194 ;; find last character of parameter-declaration | |
1195 ;; | |
1196 (if (setq match-cons | |
1197 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t)) | |
1198 (progn | |
1199 (setq epos (car match-cons)) | |
1200 (setq semipos (cdr match-cons))) | |
1201 (setq epos end)) | |
1202 | |
1203 ;; | |
1204 ;; read name(s) of parameter(s) | |
1205 ;; | |
1206 (goto-char apos) | |
1207 (looking-at "\\([a-zA-Z0-9_, \t\n]*[a-zA-Z0-9_]\\)[ \t\n]*:[^=]") | |
1208 | |
1209 (setq param (list (buffer-substring (match-beginning 1) | |
1210 (match-end 1)))) | |
1211 (ada-search-ignore-string-comment ":" nil epos t) | |
1212 | |
1213 ;; | |
1214 ;; look for 'in' | |
1215 ;; | |
1216 (setq apos (point)) | |
1217 (setq param | |
1218 (append param | |
1219 (list | |
1220 (consp | |
1221 (ada-search-ignore-string-comment "\\<in\\>" | |
1222 nil | |
1223 epos | |
1224 t))))) | |
1225 | |
1226 ;; | |
1227 ;; look for 'out' | |
1228 ;; | |
1229 (goto-char apos) | |
1230 (setq param | |
1231 (append param | |
1232 (list | |
1233 (consp | |
1234 (ada-search-ignore-string-comment "\\<out\\>" | |
1235 nil | |
1236 epos | |
1237 t))))) | |
1238 | |
1239 ;; | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1240 ;; look for 'access' |
10705 | 1241 ;; |
1242 (goto-char apos) | |
1243 (setq param | |
1244 (append param | |
1245 (list | |
1246 (consp | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1247 (ada-search-ignore-string-comment "\\<access\\>" |
10705 | 1248 nil |
1249 epos | |
1250 t))))) | |
1251 | |
1252 ;; | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1253 ;; skip 'in'/'out'/'access' |
10705 | 1254 ;; |
1255 (goto-char apos) | |
1256 (ada-goto-next-non-ws) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1257 (while (looking-at "\\<\\(in\\|out\\|access\\)\\>") |
10705 | 1258 (forward-word 1) |
1259 (ada-goto-next-non-ws)) | |
1260 | |
1261 ;; | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1262 ;; read type of parameter |
10705 | 1263 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1264 (looking-at "\\<[a-zA-Z0-9_\\.\\']+\\>") |
10705 | 1265 (setq param |
1266 (append param | |
1267 (list | |
1268 (buffer-substring (match-beginning 0) | |
1269 (match-end 0))))) | |
1270 | |
1271 ;; | |
1272 ;; read default-expression, if there is one | |
1273 ;; | |
1274 (goto-char (setq apos (match-end 0))) | |
1275 (setq param | |
1276 (append param | |
1277 (list | |
1278 (if (setq match-cons | |
1279 (ada-search-ignore-string-comment ":=" | |
1280 nil | |
1281 epos | |
1282 t)) | |
1283 (buffer-substring (car match-cons) | |
1284 epos) | |
1285 nil)))) | |
1286 ;; | |
1287 ;; add this parameter-declaration to the list | |
1288 ;; | |
1289 (setq paramlist (append paramlist (list param))) | |
1290 | |
1291 ;; | |
1292 ;; check if it was the last parameter | |
1293 ;; | |
1294 (if (eq epos end) | |
1295 (setq notend nil) | |
1296 (goto-char semipos)) | |
1297 | |
1298 ) ; end of loop | |
1299 | |
1300 (reverse paramlist))) | |
1301 | |
1302 | |
1303 (defun ada-insert-paramlist (paramlist) | |
1304 ;; Inserts a formatted PARAMLIST in the buffer. | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1305 ;; See doc of `ada-scan-paramlist' for the format. |
10705 | 1306 (let ((i (length paramlist)) |
1307 (parlen 0) | |
1308 (typlen 0) | |
1309 (temp 0) | |
1310 (inp nil) | |
1311 (outp nil) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1312 (accessp nil) |
10705 | 1313 (column nil) |
1314 (orgpoint 0) | |
1315 (firstcol nil)) | |
1316 | |
1317 ;; | |
1318 ;; loop until last parameter | |
1319 ;; | |
1320 (while (not (zerop i)) | |
1321 (setq i (1- i)) | |
1322 | |
1323 ;; | |
1324 ;; get max length of parameter-name | |
1325 ;; | |
1326 (setq parlen | |
1327 (if (<= parlen (setq temp | |
1328 (length (nth 0 (nth i paramlist))))) | |
1329 temp | |
1330 parlen)) | |
1331 | |
1332 ;; | |
1333 ;; get max length of type-name | |
1334 ;; | |
1335 (setq typlen | |
1336 (if (<= typlen (setq temp | |
1337 (length (nth 4 (nth i paramlist))))) | |
1338 temp | |
1339 typlen)) | |
1340 | |
1341 ;; | |
1342 ;; is there any 'in' ? | |
1343 ;; | |
1344 (setq inp | |
1345 (or inp | |
1346 (nth 1 (nth i paramlist)))) | |
1347 | |
1348 ;; | |
1349 ;; is there any 'out' ? | |
1350 ;; | |
1351 (setq outp | |
1352 (or outp | |
1353 (nth 2 (nth i paramlist)))) | |
1354 | |
1355 ;; | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1356 ;; is there any 'access' ? |
10705 | 1357 ;; |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1358 (setq accessp |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1359 (or accessp |
10705 | 1360 (nth 3 (nth i paramlist))))) ; end of loop |
1361 | |
1362 ;; | |
1363 ;; does paramlist already start on a separate line ? | |
1364 ;; | |
1365 (if (save-excursion | |
1366 (re-search-backward "^.\\|[^ \t]" nil t) | |
1367 (looking-at "^.")) | |
1368 ;; yes => re-indent it | |
1369 (ada-indent-current) | |
1370 ;; | |
1371 ;; no => insert newline and indent it | |
1372 ;; | |
1373 (progn | |
1374 (ada-indent-current) | |
1375 (newline) | |
1376 (delete-horizontal-space) | |
1377 (setq orgpoint (point)) | |
1378 (setq column (save-excursion | |
1379 (funcall (ada-indent-function) orgpoint))) | |
1380 (indent-to column) | |
1381 )) | |
1382 | |
1383 (insert "(") | |
1384 | |
1385 (setq firstcol (current-column)) | |
1386 (setq i (length paramlist)) | |
1387 | |
1388 ;; | |
1389 ;; loop until last parameter | |
1390 ;; | |
1391 (while (not (zerop i)) | |
1392 (setq i (1- i)) | |
1393 (setq column firstcol) | |
1394 | |
1395 ;; | |
1396 ;; insert parameter-name, space and colon | |
1397 ;; | |
1398 (insert (nth 0 (nth i paramlist))) | |
1399 (indent-to (+ column parlen 1)) | |
1400 (insert ": ") | |
1401 (setq column (current-column)) | |
1402 | |
1403 ;; | |
1404 ;; insert 'in' or space | |
1405 ;; | |
1406 (if (nth 1 (nth i paramlist)) | |
1407 (insert "in ") | |
1408 (if (and | |
1409 (or inp | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1410 accessp) |
10705 | 1411 (not (nth 3 (nth i paramlist)))) |
1412 (insert " "))) | |
1413 | |
1414 ;; | |
1415 ;; insert 'out' or space | |
1416 ;; | |
1417 (if (nth 2 (nth i paramlist)) | |
1418 (insert "out ") | |
1419 (if (and | |
1420 (or outp | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1421 accessp) |
10705 | 1422 (not (nth 3 (nth i paramlist)))) |
1423 (insert " "))) | |
1424 | |
1425 ;; | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1426 ;; insert 'access' |
10705 | 1427 ;; |
1428 (if (nth 3 (nth i paramlist)) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1429 (insert "access ")) |
10705 | 1430 |
1431 (setq column (current-column)) | |
1432 | |
1433 ;; | |
1434 ;; insert type-name and, if necessary, space and default-expression | |
1435 ;; | |
1436 (insert (nth 4 (nth i paramlist))) | |
1437 (if (nth 5 (nth i paramlist)) | |
1438 (progn | |
1439 (indent-to (+ column typlen 1)) | |
1440 (insert (nth 5 (nth i paramlist))))) | |
1441 | |
1442 ;; | |
1443 ;; check if it was the last parameter | |
1444 ;; | |
1445 (if (not (zerop i)) | |
1446 ;; no => insert ';' and newline and indent | |
1447 (progn | |
1448 (insert ";") | |
1449 (newline) | |
1450 (indent-to firstcol)) | |
1451 ;; yes | |
1452 (insert ")")) | |
1453 | |
1454 ) ; end of loop | |
1455 | |
1456 ;; | |
1457 ;; if anything follows, except semicolon: | |
1458 ;; put it in a new line and indent it | |
1459 ;; | |
1460 (if (not (looking-at "[ \t]*[;\n]")) | |
1461 (ada-indent-newline-indent)) | |
1462 | |
1463 )) | |
1464 | |
1465 | |
1466 ;;;----------------------------;;; | |
1467 ;;; Move To Matching Start/End ;;; | |
1468 ;;;----------------------------;;; | |
1469 | |
1470 (defun ada-move-to-start () | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1471 "Moves point to the matching start of the current Ada structure." |
10705 | 1472 (interactive) |
1473 (let ((pos (point))) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1474 (unwind-protect |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1475 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1476 (set-syntax-table ada-mode-symbol-syntax-table) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1477 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1478 (message "searching for block start ...") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1479 (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1480 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1481 ;; do nothing if in string or comment or not on 'end ...;' |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1482 ;; or if an error occurs during processing |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1483 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1484 (or |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1485 (ada-in-string-or-comment-p) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1486 (and (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1487 (or (looking-at "[ \t]*\\<end\\>") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1488 (backward-word 1)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1489 (or (looking-at "[ \t]*\\<end\\>") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1490 (backward-word 1)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1491 (or (looking-at "[ \t]*\\<end\\>") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1492 (error "not on end ...;"))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1493 (ada-goto-matching-start 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1494 (setq pos (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1495 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1496 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1497 ;; on 'begin' => go on, according to user option |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1498 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1499 ada-move-to-declaration |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1500 (looking-at "\\<begin\\>") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1501 (ada-goto-matching-decl-start) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1502 (setq pos (point)))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1503 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1504 ) ; end of save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1505 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1506 ;; now really move to the found position |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1507 (goto-char pos) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1508 (message "searching for block start ... done")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1509 |
10705 | 1510 ;; |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1511 ;; restore syntax-table |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1512 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1513 (set-syntax-table ada-mode-syntax-table)))) |
10705 | 1514 |
1515 | |
1516 (defun ada-move-to-end () | |
1517 "Moves point to the matching end of the current block around point. | |
1518 Moves to 'begin' if in a declarative part." | |
1519 (interactive) | |
1520 (let ((pos (point)) | |
1521 (decstart nil) | |
1522 (packdecl nil)) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1523 (unwind-protect |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1524 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1525 (set-syntax-table ada-mode-symbol-syntax-table) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1526 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1527 (message "searching for block end ...") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1528 (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1529 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1530 (forward-char 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1531 (cond |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1532 ;; directly on 'begin' |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1533 ((save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1534 (ada-goto-previous-word) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1535 (looking-at "\\<begin\\>")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1536 (ada-goto-matching-end 1)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1537 ;; on first line of defun declaration |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1538 ((save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1539 (and (ada-goto-stmt-start) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1540 (looking-at "\\<function\\>\\|\\<procedure\\>" ))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1541 (ada-search-ignore-string-comment "\\<begin\\>")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1542 ;; on first line of task declaration |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1543 ((save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1544 (and (ada-goto-stmt-start) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1545 (looking-at "\\<task\\>" ) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1546 (forward-word 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1547 (ada-search-ignore-string-comment "[^ \n\t]") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1548 (not (backward-char 1)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1549 (looking-at "\\<body\\>"))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1550 (ada-search-ignore-string-comment "\\<begin\\>")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1551 ;; accept block start |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1552 ((save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1553 (and (ada-goto-stmt-start) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1554 (looking-at "\\<accept\\>" ))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1555 (ada-goto-matching-end 0)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1556 ;; package start |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1557 ((save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1558 (and (ada-goto-matching-decl-start t) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1559 (looking-at "\\<package\\>"))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1560 (ada-goto-matching-end 1)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1561 ;; inside a 'begin' ... 'end' block |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1562 ((save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1563 (ada-goto-matching-decl-start t)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1564 (ada-search-ignore-string-comment "\\<begin\\>")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1565 ;; (hopefully ;-) everything else |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1566 (t |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1567 (ada-goto-matching-end 1))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1568 (setq pos (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1569 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1570 ) ; end of save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1571 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1572 ;; now really move to the found position |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1573 (goto-char pos) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1574 (message "searching for block end ... done")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1575 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1576 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1577 ;; restore syntax-table |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1578 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1579 (set-syntax-table ada-mode-syntax-table)))) |
10705 | 1580 |
1581 | |
1582 ;;;-----------------------------;;; | |
1583 ;;; Functions For Indentation ;;; | |
1584 ;;;-----------------------------;;; | |
1585 | |
1586 ;; ---- main functions for indentation | |
1587 | |
1588 (defun ada-indent-region (beg end) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1589 "Indents the region using `ada-indent-current' on each line." |
10705 | 1590 (interactive "*r") |
1591 (goto-char beg) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1592 (let ((block-done 0) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1593 (lines-remaining (count-lines beg end)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1594 (msg (format "indenting %4d lines %%4d lines remaining ..." |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1595 (count-lines beg end))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1596 (endmark (copy-marker end))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1597 ;; catch errors while indenting |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1598 (condition-case err |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1599 (while (< (point) endmark) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1600 (if (> block-done 9) |
14337
c819273fe29c
(ada-adjust-case-region, ada-indent-region): Delete format call inside message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
1601 (progn (message msg lines-remaining) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1602 (setq block-done 0))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1603 (if (looking-at "^$") nil |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1604 (ada-indent-current)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1605 (forward-line 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1606 (setq block-done (1+ block-done)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1607 (setq lines-remaining (1- lines-remaining))) |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
1608 ;; show line number where the error occurred |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1609 (error |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1610 (error "line %d: %s" (1+ (count-lines (point-min) (point))) err) nil)) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1611 (message "indenting ... done"))) |
10705 | 1612 |
1613 | |
1614 (defun ada-indent-newline-indent () | |
1615 "Indents the current line, inserts a newline and then indents the new line." | |
1616 (interactive "*") | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1617 (ada-indent-current) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1618 (newline) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1619 (ada-indent-current)) |
10705 | 1620 |
1621 | |
1622 (defun ada-indent-current () | |
1623 "Indents current line as Ada code. | |
1624 This works by two steps: | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
1625 1) It moves point to the end of the previous code line. |
10705 | 1626 Then it calls the function to calculate the indentation for the |
1627 following line as if a newline would be inserted there. | |
1628 The calculated column # is saved and the old position of point | |
1629 is restored. | |
1630 2) Then another function is called to calculate the indentation for | |
1631 the current line, based on the previously calculated column #." | |
1632 | |
1633 (interactive) | |
1634 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1635 (unwind-protect |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1636 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1637 (set-syntax-table ada-mode-symbol-syntax-table) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1638 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1639 (let ((line-end) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1640 (orgpoint (point-marker)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1641 (cur-indent) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1642 (prev-indent) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1643 (prevline t)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1644 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1645 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1646 ;; first step |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1647 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1648 (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1649 (if (ada-goto-prev-nonblank-line t) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1650 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1651 ;; we are not in the first accessible line in the buffer |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1652 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1653 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1654 ;;(end-of-line) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1655 ;;(forward-char 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1656 ;; we are already at the BOL |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1657 (forward-line 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1658 (setq line-end (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1659 (setq prev-indent |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1660 (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1661 (funcall (ada-indent-function) line-end)))) |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1662 (progn ; first line of buffer -> set indent |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1663 (beginning-of-line) ; to 0 |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1664 (delete-horizontal-space) |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1665 (setq prevline nil)))) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1666 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1667 (if prevline |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1668 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1669 ;; we are not in the first accessible line in the buffer |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1670 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1671 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1672 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1673 ;; second step |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1674 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1675 (back-to-indentation) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1676 (setq cur-indent (ada-get-current-indent prev-indent)) |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1677 ;; only reindent if indentation is different then the current |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1678 (if (= (current-column) cur-indent) |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1679 nil |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1680 (delete-horizontal-space) |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
1681 (indent-to cur-indent)) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1682 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1683 ;; restore position of point |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1684 ;; |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1685 (goto-char orgpoint) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1686 (if (< (current-column) (current-indentation)) |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1687 (back-to-indentation)))))) |
10705 | 1688 |
1689 ;; | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1690 ;; restore syntax-table |
10705 | 1691 ;; |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1692 (set-syntax-table ada-mode-syntax-table))) |
10705 | 1693 |
1694 | |
1695 (defun ada-get-current-indent (prev-indent) | |
1696 ;; Returns the column # to indent the current line to. | |
1697 ;; PREV-INDENT is the indentation resulting from the previous lines. | |
1698 (let ((column nil) | |
1699 (pos nil) | |
1700 (match-cons nil)) | |
1701 | |
1702 (cond | |
1703 ;; | |
1704 ;; in open parenthesis, but not in parameter-list | |
1705 ;; | |
1706 ((and | |
1707 ada-indent-to-open-paren | |
1708 (not (ada-in-paramlist-p)) | |
1709 (setq column (ada-in-open-paren-p))) | |
1710 ;; check if we have something like this (Table_Component_Type => | |
1711 ;; Source_File_Record,) | |
1712 (save-excursion | |
1713 (if (and (ada-search-ignore-string-comment "[^ \t]" t nil) | |
1714 (looking-at "\n") | |
1715 (ada-search-ignore-string-comment "[^ \t\n]" t nil) | |
1716 (looking-at ">")) | |
1717 (setq column (+ ada-broken-indent column)))) | |
1718 column) | |
1719 | |
1720 ;; | |
1721 ;; end | |
1722 ;; | |
1723 ((looking-at "\\<end\\>") | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1724 (let ((label 0)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1725 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1726 (ada-goto-matching-start 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1727 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1728 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1729 ;; found 'loop' => skip back to 'while' or 'for' |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1730 ;; if 'loop' is not on a separate line |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1731 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1732 (if (and |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1733 (looking-at "\\<loop\\>") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1734 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1735 (back-to-indentation) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1736 (not (looking-at "\\<loop\\>")))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1737 (if (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1738 (and |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1739 (setq match-cons |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1740 (ada-search-ignore-string-comment |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1741 ada-loop-start-re t nil)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1742 (not (looking-at "\\<loop\\>")))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1743 (progn |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1744 (goto-char (car match-cons)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1745 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1746 (beginning-of-line) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1747 (if (looking-at ada-named-block-re) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1748 (setq label (- ada-label-indent))))))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1749 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1750 (+ (current-indentation) label)))) |
10705 | 1751 ;; |
1752 ;; exception | |
1753 ;; | |
1754 ((looking-at "\\<exception\\>") | |
1755 (save-excursion | |
1756 (ada-goto-matching-start 1) | |
1757 (current-indentation))) | |
1758 ;; | |
1759 ;; when | |
1760 ;; | |
1761 ((looking-at "\\<when\\>") | |
1762 (save-excursion | |
1763 (ada-goto-matching-start 1) | |
1764 (+ (current-indentation) ada-when-indent))) | |
1765 ;; | |
1766 ;; else | |
1767 ;; | |
1768 ((looking-at "\\<else\\>") | |
1769 (if (save-excursion | |
1770 (ada-goto-previous-word) | |
1771 (looking-at "\\<or\\>")) | |
1772 prev-indent | |
1773 (save-excursion | |
1774 (ada-goto-matching-start 1 nil t) | |
1775 (current-indentation)))) | |
1776 ;; | |
1777 ;; elsif | |
1778 ;; | |
1779 ((looking-at "\\<elsif\\>") | |
1780 (save-excursion | |
1781 (ada-goto-matching-start 1 nil t) | |
1782 (current-indentation))) | |
1783 ;; | |
1784 ;; then | |
1785 ;; | |
1786 ((looking-at "\\<then\\>") | |
1787 (if (save-excursion | |
1788 (ada-goto-previous-word) | |
1789 (looking-at "\\<and\\>")) | |
1790 prev-indent | |
1791 (save-excursion | |
1792 (ada-search-ignore-string-comment "\\<elsif\\>\\|\\<if\\>" t nil) | |
1793 (+ (current-indentation) ada-stmt-end-indent)))) | |
1794 ;; | |
1795 ;; loop | |
1796 ;; | |
1797 ((looking-at "\\<loop\\>") | |
1798 (setq pos (point)) | |
1799 (save-excursion | |
1800 (goto-char (match-end 0)) | |
1801 (ada-goto-stmt-start) | |
1802 (if (looking-at "\\<loop\\>\\|\\<if\\>") | |
1803 prev-indent | |
1804 (progn | |
1805 (if (not (looking-at ada-loop-start-re)) | |
1806 (ada-search-ignore-string-comment ada-loop-start-re | |
1807 nil pos)) | |
1808 (if (looking-at "\\<loop\\>") | |
1809 prev-indent | |
1810 (+ (current-indentation) ada-stmt-end-indent)))))) | |
1811 ;; | |
1812 ;; begin | |
1813 ;; | |
1814 ((looking-at "\\<begin\\>") | |
1815 (save-excursion | |
1816 (if (ada-goto-matching-decl-start t) | |
1817 (current-indentation) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1818 prev-indent))) |
10705 | 1819 ;; |
1820 ;; is | |
1821 ;; | |
1822 ((looking-at "\\<is\\>") | |
1823 (if (and | |
1824 ada-indent-is-separate | |
1825 (save-excursion | |
1826 (goto-char (match-end 0)) | |
1827 (ada-goto-next-non-ws (save-excursion | |
1828 (end-of-line) | |
1829 (point))) | |
1830 (looking-at "\\<abstract\\>\\|\\<separate\\>"))) | |
1831 (save-excursion | |
1832 (ada-goto-stmt-start) | |
1833 (+ (current-indentation) ada-indent)) | |
1834 (save-excursion | |
1835 (ada-goto-stmt-start) | |
1836 (+ (current-indentation) ada-stmt-end-indent)))) | |
1837 ;; | |
1838 ;; record | |
1839 ;; | |
1840 ((looking-at "\\<record\\>") | |
1841 (save-excursion | |
1842 (ada-search-ignore-string-comment | |
1843 "\\<\\(type\\|use\\)\\>" t nil) | |
1844 (if (looking-at "\\<use\\>") | |
1845 (ada-search-ignore-string-comment "\\<for\\>" t nil)) | |
1846 (+ (current-indentation) ada-indent-record-rel-type))) | |
1847 ;; | |
1848 ;; or as statement-start | |
1849 ;; | |
1850 ((ada-looking-at-semi-or) | |
1851 (save-excursion | |
1852 (ada-goto-matching-start 1) | |
1853 (current-indentation))) | |
1854 ;; | |
1855 ;; private as statement-start | |
1856 ;; | |
1857 ((ada-looking-at-semi-private) | |
1858 (save-excursion | |
1859 (ada-goto-matching-decl-start) | |
1860 (current-indentation))) | |
1861 ;; | |
1862 ;; new/abstract/separate | |
1863 ;; | |
1864 ((looking-at "\\<\\(new\\|abstract\\|separate\\)\\>") | |
1865 (- prev-indent ada-indent (- ada-broken-indent))) | |
1866 ;; | |
1867 ;; return | |
1868 ;; | |
1869 ((looking-at "\\<return\\>") | |
1870 (save-excursion | |
1871 (forward-sexp -1) | |
1872 (if (and (looking-at "(") | |
1873 (save-excursion | |
1874 (backward-sexp 2) | |
1875 (looking-at "\\<function\\>"))) | |
1876 (1+ (current-column)) | |
1877 prev-indent))) | |
1878 ;; | |
1879 ;; do | |
1880 ;; | |
1881 ((looking-at "\\<do\\>") | |
1882 (save-excursion | |
1883 (ada-goto-stmt-start) | |
1884 (+ (current-indentation) ada-stmt-end-indent))) | |
1885 ;; | |
1886 ;; package/function/procedure | |
1887 ;; | |
1888 ((and (looking-at "\\<\\(package\\|function\\|procedure\\)\\>") | |
1889 (save-excursion | |
1890 (forward-char 1) | |
1891 (ada-goto-stmt-start) | |
1892 (looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))) | |
1893 (save-excursion | |
1894 ;; look for 'generic' | |
1895 (if (and (ada-goto-matching-decl-start t) | |
1896 (looking-at "generic")) | |
1897 (current-column) | |
1898 prev-indent))) | |
1899 ;; | |
1900 ;; label | |
1901 ;; | |
1902 ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*:[^=]") | |
1903 (if (ada-in-decl-p) | |
1904 prev-indent | |
1905 (+ prev-indent ada-label-indent))) | |
1906 ;; | |
1907 ;; identifier and other noindent-statements | |
1908 ;; | |
1909 ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*") | |
1910 prev-indent) | |
1911 ;; | |
1912 ;; beginning of a parameter list | |
1913 ;; | |
1914 ((looking-at "(") | |
1915 prev-indent) | |
1916 ;; | |
1917 ;; end of a parameter list | |
1918 ;; | |
1919 ((looking-at ")") | |
1920 (save-excursion | |
1921 (forward-char 1) | |
1922 (backward-sexp 1) | |
1923 (current-column))) | |
1924 ;; | |
1925 ;; comment | |
1926 ;; | |
1927 ((looking-at "--") | |
1928 (if ada-indent-comment-as-code | |
1929 prev-indent | |
1930 (current-indentation))) | |
1931 ;; | |
1932 ;; unknown syntax - maybe this should signal an error ? | |
1933 ;; | |
1934 (t | |
1935 prev-indent)))) | |
1936 | |
1937 | |
1938 (defun ada-indent-function (&optional nomove) | |
1939 ;; Returns the function to calculate the indentation for the current | |
1940 ;; line according to the previous statement, ignoring the contents | |
1941 ;; of the current line after point. Moves point to the beginning of | |
1942 ;; the current statement, if NOMOVE is nil. | |
1943 | |
1944 (let ((orgpoint (point)) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1945 (func nil)) |
10705 | 1946 ;; |
1947 ;; inside a parameter-list | |
1948 ;; | |
1949 (if (ada-in-paramlist-p) | |
1950 (setq func 'ada-get-indent-paramlist) | |
1951 (progn | |
1952 ;; | |
1953 ;; move to beginning of current statement | |
1954 ;; | |
1955 (if (not nomove) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1956 (ada-goto-stmt-start)) |
10705 | 1957 ;; |
1958 ;; no beginning found => don't change indentation | |
1959 ;; | |
1960 (if (and | |
1961 (eq orgpoint (point)) | |
1962 (not nomove)) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
1963 (setq func 'ada-get-indent-nochange) |
10705 | 1964 |
1965 (cond | |
1966 ;; | |
1967 ((and | |
1968 ada-indent-to-open-paren | |
1969 (ada-in-open-paren-p)) | |
1970 (setq func 'ada-get-indent-open-paren)) | |
1971 ;; | |
1972 ((looking-at "\\<end\\>") | |
1973 (setq func 'ada-get-indent-end)) | |
1974 ;; | |
1975 ((looking-at ada-loop-start-re) | |
1976 (setq func 'ada-get-indent-loop)) | |
1977 ;; | |
1978 ((looking-at ada-subprog-start-re) | |
1979 (setq func 'ada-get-indent-subprog)) | |
1980 ;; | |
1981 ((looking-at ada-block-start-re) | |
1982 (setq func 'ada-get-indent-block-start)) | |
1983 ;; | |
1984 ((looking-at "\\<type\\>") | |
1985 (setq func 'ada-get-indent-type)) | |
1986 ;; | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
1987 ((looking-at "\\<\\(els\\)?if\\>") |
10705 | 1988 (setq func 'ada-get-indent-if)) |
1989 ;; | |
1990 ((looking-at "\\<case\\>") | |
1991 (setq func 'ada-get-indent-case)) | |
1992 ;; | |
1993 ((looking-at "\\<when\\>") | |
1994 (setq func 'ada-get-indent-when)) | |
1995 ;; | |
1996 ((looking-at "--") | |
1997 (setq func 'ada-get-indent-comment)) | |
1998 ;; | |
1999 ((looking-at "[a-zA-Z0-9_]+[ \t\n]*:[^=]") | |
2000 (setq func 'ada-get-indent-label)) | |
2001 ;; | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2002 ((looking-at "\\<separate\\>") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2003 (setq func 'ada-get-indent-nochange)) |
10705 | 2004 (t |
2005 (setq func 'ada-get-indent-noindent)))))) | |
2006 | |
2007 func)) | |
2008 | |
2009 | |
2010 ;; ---- functions to return indentation for special cases | |
2011 | |
2012 (defun ada-get-indent-open-paren (orgpoint) | |
2013 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
2014 ;; Assumes point to be behind an open parenthesis not yet closed. |
10705 | 2015 (ada-in-open-paren-p)) |
2016 | |
2017 | |
2018 (defun ada-get-indent-nochange (orgpoint) | |
2019 ;; Returns the indentation (column #) of the current line. | |
2020 (save-excursion | |
2021 (forward-line -1) | |
2022 (current-indentation))) | |
2023 | |
2024 | |
2025 (defun ada-get-indent-paramlist (orgpoint) | |
2026 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2027 ;; Assumes point to be inside a parameter-list. | |
2028 (save-excursion | |
2029 (ada-search-ignore-string-comment "[^ \t\n]" t nil t) | |
2030 (cond | |
2031 ;; | |
2032 ;; in front of the first parameter | |
2033 ;; | |
2034 ((looking-at "(") | |
2035 (goto-char (match-end 0)) | |
2036 (current-column)) | |
2037 ;; | |
2038 ;; in front of another parameter | |
2039 ;; | |
2040 ((looking-at ";") | |
2041 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) | |
2042 (ada-goto-next-non-ws) | |
2043 (current-column)) | |
2044 ;; | |
2045 ;; inside a parameter declaration | |
2046 ;; | |
2047 (t | |
2048 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) | |
2049 (ada-goto-next-non-ws) | |
2050 (+ (current-column) ada-broken-indent))))) | |
2051 | |
2052 | |
2053 (defun ada-get-indent-end (orgpoint) | |
2054 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2055 ;; Assumes point to be at the beginning of an end-statement. | |
2056 ;; Therefore it has to find the corresponding start. This can be a little | |
2057 ;; slow, if it has to search through big files with many nested blocks. | |
2058 ;; Signals an error if the corresponding block-start doesn't match. | |
2059 (let ((defun-name nil) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2060 (label 0) |
10705 | 2061 (indent nil)) |
2062 ;; | |
2063 ;; is the line already terminated by ';' ? | |
2064 ;; | |
2065 (if (save-excursion | |
2066 (ada-search-ignore-string-comment ";" nil orgpoint)) | |
2067 ;; | |
2068 ;; yes, look what's following 'end' | |
2069 ;; | |
2070 (progn | |
2071 (forward-word 1) | |
2072 (ada-goto-next-non-ws) | |
2073 (cond | |
2074 ;; | |
2075 ;; loop/select/if/case/record/select | |
2076 ;; | |
2077 ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>") | |
2078 (save-excursion | |
2079 (ada-check-matching-start | |
2080 (buffer-substring (match-beginning 0) | |
2081 (match-end 0))) | |
2082 (if (looking-at "\\<\\(loop\\|record\\)\\>") | |
2083 (progn | |
2084 (forward-word 1) | |
2085 (ada-goto-stmt-start))) | |
2086 ;; a label ? => skip it | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2087 (if (looking-at ada-named-block-re) |
10705 | 2088 (progn |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2089 (setq label (- ada-label-indent)) |
10705 | 2090 (goto-char (match-end 0)) |
2091 (ada-goto-next-non-ws))) | |
2092 ;; really looking-at the right thing ? | |
2093 (or (looking-at (concat "\\<\\(" | |
2094 "loop\\|select\\|if\\|case\\|" | |
2095 "record\\|while\\|type\\)\\>")) | |
2096 (progn | |
2097 (ada-search-ignore-string-comment | |
2098 (concat "\\<\\(" | |
2099 "loop\\|select\\|if\\|case\\|" | |
2100 "record\\|while\\|type\\)\\>"))) | |
2101 (backward-word 1)) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2102 (+ (current-indentation) label))) |
10705 | 2103 ;; |
2104 ;; a named block end | |
2105 ;; | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2106 ((looking-at ada-ident-re) |
10705 | 2107 (setq defun-name (buffer-substring (match-beginning 0) |
2108 (match-end 0))) | |
2109 (save-excursion | |
2110 (ada-goto-matching-start 0) | |
2111 (ada-check-defun-name defun-name) | |
2112 (current-indentation))) | |
2113 ;; | |
2114 ;; a block-end without name | |
2115 ;; | |
2116 ((looking-at ";") | |
2117 (save-excursion | |
2118 (ada-goto-matching-start 0) | |
2119 (if (looking-at "\\<begin\\>") | |
2120 (progn | |
2121 (setq indent (current-column)) | |
2122 (if (ada-goto-matching-decl-start t) | |
2123 (current-indentation) | |
2124 indent))))) | |
2125 ;; | |
2126 ;; anything else - should maybe signal an error ? | |
2127 ;; | |
2128 (t | |
2129 (+ (current-indentation) ada-broken-indent)))) | |
2130 | |
2131 (+ (current-indentation) ada-broken-indent)))) | |
2132 | |
2133 | |
2134 (defun ada-get-indent-case (orgpoint) | |
2135 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2136 ;; Assumes point to be at the beginning of a case-statement. |
10705 | 2137 (let ((cur-indent (current-indentation)) |
2138 (match-cons nil) | |
2139 (opos (point))) | |
2140 (cond | |
2141 ;; | |
2142 ;; case..is..when..=> | |
2143 ;; | |
2144 ((save-excursion | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2145 (setq match-cons (and |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2146 ;; the `=>' must be after the keyword `is'. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2147 (ada-search-ignore-string-comment |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2148 "\\<is\\>" nil orgpoint) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2149 (ada-search-ignore-string-comment |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2150 "[ \t\n]+=>" nil orgpoint)))) |
10705 | 2151 (save-excursion |
2152 (goto-char (car match-cons)) | |
2153 (if (not (ada-search-ignore-string-comment "\\<when\\>" t opos)) | |
2154 (error "missing 'when' between 'case' and '=>'")) | |
2155 (+ (current-indentation) ada-indent))) | |
2156 ;; | |
2157 ;; case..is..when | |
2158 ;; | |
2159 ((save-excursion | |
2160 (setq match-cons (ada-search-ignore-string-comment | |
2161 "\\<when\\>" nil orgpoint))) | |
2162 (goto-char (cdr match-cons)) | |
2163 (+ (current-indentation) ada-broken-indent)) | |
2164 ;; | |
2165 ;; case..is | |
2166 ;; | |
2167 ((save-excursion | |
2168 (setq match-cons (ada-search-ignore-string-comment | |
2169 "\\<is\\>" nil orgpoint))) | |
2170 (+ (current-indentation) ada-when-indent)) | |
2171 ;; | |
2172 ;; incomplete case | |
2173 ;; | |
2174 (t | |
2175 (+ (current-indentation) ada-broken-indent))))) | |
2176 | |
2177 | |
2178 (defun ada-get-indent-when (orgpoint) | |
2179 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2180 ;; Assumes point to be at the beginning of an when-statement. | |
2181 (let ((cur-indent (current-indentation))) | |
2182 (if (ada-search-ignore-string-comment | |
2183 "[ \t\n]+=>" nil orgpoint) | |
2184 (+ cur-indent ada-indent) | |
2185 (+ cur-indent ada-broken-indent)))) | |
2186 | |
2187 | |
2188 (defun ada-get-indent-if (orgpoint) | |
2189 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2190 ;; Assumes point to be at the beginning of an if-statement. | |
2191 (let ((cur-indent (current-indentation)) | |
2192 (match-cons nil)) | |
2193 ;; | |
2194 ;; if..then ? | |
2195 ;; | |
2196 (if (ada-search-but-not | |
2197 "\\<then\\>" "\\<and\\>[ \t\n]+\\<then\\>" nil orgpoint) | |
2198 | |
2199 (progn | |
2200 ;; | |
2201 ;; 'then' first in separate line ? | |
2202 ;; => indent according to 'then' | |
2203 ;; | |
2204 (if (save-excursion | |
2205 (back-to-indentation) | |
2206 (looking-at "\\<then\\>")) | |
2207 (setq cur-indent (current-indentation))) | |
2208 (forward-word 1) | |
2209 ;; | |
2210 ;; something follows 'then' ? | |
2211 ;; | |
2212 (if (setq match-cons | |
2213 (ada-search-ignore-string-comment | |
2214 "[^ \t\n]" nil orgpoint)) | |
2215 (progn | |
2216 (goto-char (car match-cons)) | |
2217 (+ ada-indent | |
2218 (- cur-indent (current-indentation)) | |
2219 (funcall (ada-indent-function t) orgpoint))) | |
2220 | |
2221 (+ cur-indent ada-indent))) | |
2222 | |
2223 (+ cur-indent ada-broken-indent)))) | |
2224 | |
2225 | |
2226 (defun ada-get-indent-block-start (orgpoint) | |
2227 ;; Returns the indentation (column #) for the new line after | |
2228 ;; ORGPOINT. Assumes point to be at the beginning of a block start | |
2229 ;; keyword. | |
2230 (let ((cur-indent (current-indentation)) | |
2231 (pos nil)) | |
2232 (cond | |
2233 ((save-excursion | |
2234 (forward-word 1) | |
2235 (setq pos (car (ada-search-ignore-string-comment | |
2236 "[^ \t\n]" nil orgpoint)))) | |
2237 (goto-char pos) | |
2238 (save-excursion | |
2239 (funcall (ada-indent-function t) orgpoint))) | |
2240 ;; | |
2241 ;; nothing follows the block-start | |
2242 ;; | |
2243 (t | |
2244 (+ (current-indentation) ada-indent))))) | |
2245 | |
2246 | |
2247 (defun ada-get-indent-subprog (orgpoint) | |
2248 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2249 ;; Assumes point to be at the beginning of a subprog-/package-declaration. | |
2250 (let ((match-cons nil) | |
2251 (cur-indent (current-indentation)) | |
2252 (foundis nil) | |
2253 (addind 0) | |
2254 (fstart (point))) | |
2255 ;; | |
2256 ;; is there an 'is' in front of point ? | |
2257 ;; | |
2258 (if (save-excursion | |
2259 (setq match-cons | |
2260 (ada-search-ignore-string-comment | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2261 "\\<\\(is\\|do\\)\\>" nil orgpoint))) |
10705 | 2262 ;; |
2263 ;; yes, then skip to its end | |
2264 ;; | |
2265 (progn | |
2266 (setq foundis t) | |
2267 (goto-char (cdr match-cons))) | |
2268 ;; | |
2269 ;; no, then goto next non-ws, if there is one in front of point | |
2270 ;; | |
2271 (progn | |
2272 (if (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint) | |
2273 (ada-goto-next-non-ws) | |
2274 (goto-char orgpoint)))) | |
2275 | |
2276 (cond | |
2277 ;; | |
2278 ;; nothing follows 'is' | |
2279 ;; | |
2280 ((and | |
2281 foundis | |
2282 (save-excursion | |
2283 (not (ada-search-ignore-string-comment | |
2284 "[^ \t\n]" nil orgpoint t)))) | |
2285 (+ cur-indent ada-indent)) | |
2286 ;; | |
2287 ;; is abstract/separate/new ... | |
2288 ;; | |
2289 ((and | |
2290 foundis | |
2291 (save-excursion | |
2292 (setq match-cons | |
2293 (ada-search-ignore-string-comment | |
2294 "\\<\\(separate\\|new\\|abstract\\)\\>" | |
2295 nil orgpoint)))) | |
2296 (goto-char (car match-cons)) | |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
2297 (ada-search-ignore-string-comment ada-subprog-start-re t) |
10705 | 2298 (ada-get-indent-noindent orgpoint)) |
2299 ;; | |
2300 ;; something follows 'is' | |
2301 ;; | |
2302 ((and | |
2303 foundis | |
2304 (save-excursion | |
2305 (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)) | |
2306 (ada-goto-next-non-ws) | |
2307 (funcall (ada-indent-function t) orgpoint))) | |
2308 ;; | |
2309 ;; no 'is' but ';' | |
2310 ;; | |
2311 ((save-excursion | |
2312 (ada-search-ignore-string-comment ";" nil orgpoint)) | |
2313 cur-indent) | |
2314 ;; | |
2315 ;; no 'is' or ';' | |
2316 ;; | |
2317 (t | |
2318 (+ cur-indent ada-broken-indent))))) | |
2319 | |
2320 | |
2321 (defun ada-get-indent-noindent (orgpoint) | |
2322 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2323 ;; Assumes point to be at the beginning of a 'noindent statement'. | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2324 (let ((label 0)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2325 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2326 (beginning-of-line) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2327 (if (looking-at ada-named-block-re) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2328 (setq label (- ada-label-indent)))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2329 (if (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2330 (ada-search-ignore-string-comment ";" nil orgpoint)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2331 (+ (current-indentation) label) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2332 (+ (current-indentation) ada-broken-indent label)))) |
10705 | 2333 |
2334 | |
2335 (defun ada-get-indent-label (orgpoint) | |
2336 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2337 ;; Assumes point to be at the beginning of a label or variable declaration. | |
2338 ;; Checks the context to decide if it's a label or a variable declaration. | |
2339 ;; This check might be a bit slow. | |
2340 (let ((match-cons nil) | |
2341 (cur-indent (current-indentation))) | |
2342 (goto-char (cdr (ada-search-ignore-string-comment ":"))) | |
2343 (cond | |
2344 ;; | |
2345 ;; loop label | |
2346 ;; | |
2347 ((save-excursion | |
2348 (setq match-cons (ada-search-ignore-string-comment | |
2349 ada-loop-start-re nil orgpoint))) | |
2350 (goto-char (car match-cons)) | |
2351 (ada-get-indent-loop orgpoint)) | |
2352 ;; | |
2353 ;; declare label | |
2354 ;; | |
2355 ((save-excursion | |
2356 (setq match-cons (ada-search-ignore-string-comment | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2357 "\\<declare\\|begin\\>" nil orgpoint))) |
10705 | 2358 (save-excursion |
2359 (goto-char (car match-cons)) | |
2360 (+ (current-indentation) ada-indent))) | |
2361 ;; | |
2362 ;; complete statement following colon | |
2363 ;; | |
2364 ((save-excursion | |
2365 (ada-search-ignore-string-comment ";" nil orgpoint)) | |
2366 (if (ada-in-decl-p) | |
2367 cur-indent ; variable-declaration | |
2368 (- cur-indent ada-label-indent))) ; label | |
2369 ;; | |
2370 ;; broken statement | |
2371 ;; | |
2372 ((save-excursion | |
2373 (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)) | |
2374 (if (ada-in-decl-p) | |
2375 (+ cur-indent ada-broken-indent) | |
2376 (+ cur-indent ada-broken-indent (- ada-label-indent)))) | |
2377 ;; | |
2378 ;; nothing follows colon | |
2379 ;; | |
2380 (t | |
2381 (if (ada-in-decl-p) | |
2382 (+ cur-indent ada-broken-indent) ; variable-declaration | |
2383 (- cur-indent ada-label-indent)))))) ; label | |
2384 | |
2385 | |
2386 (defun ada-get-indent-loop (orgpoint) | |
2387 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2388 ;; Assumes point to be at the beginning of a loop statement | |
2389 ;; or (unfortunately) also a for ... use statement. | |
2390 (let ((match-cons nil) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2391 (pos (point)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2392 (label (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2393 (beginning-of-line) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2394 (if (looking-at ada-named-block-re) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2395 (- ada-label-indent) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2396 0)))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2397 |
10705 | 2398 (cond |
2399 | |
2400 ;; | |
2401 ;; statement complete | |
2402 ;; | |
2403 ((save-excursion | |
2404 (ada-search-ignore-string-comment ";" nil orgpoint)) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2405 (+ (current-indentation) label)) |
10705 | 2406 ;; |
2407 ;; simple loop | |
2408 ;; | |
2409 ((looking-at "loop\\>") | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2410 (+ (ada-get-indent-block-start orgpoint) label)) |
10705 | 2411 |
2412 ;; | |
2413 ;; 'for'- loop (or also a for ... use statement) | |
2414 ;; | |
2415 ((looking-at "for\\>") | |
2416 (cond | |
2417 ;; | |
2418 ;; for ... use | |
2419 ;; | |
2420 ((save-excursion | |
2421 (and | |
2422 (goto-char (match-end 0)) | |
2423 (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint) | |
2424 (not (backward-char 1)) | |
2425 (not (zerop (skip-chars-forward "_a-zA-Z0-9'"))) | |
2426 (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint) | |
2427 (not (backward-char 1)) | |
2428 (looking-at "\\<use\\>") | |
2429 ;; | |
2430 ;; check if there is a 'record' before point | |
2431 ;; | |
2432 (progn | |
2433 (setq match-cons (ada-search-ignore-string-comment | |
2434 "\\<record\\>" nil orgpoint)) | |
2435 t))) | |
2436 (if match-cons | |
2437 (goto-char (car match-cons))) | |
2438 (+ (current-indentation) ada-indent)) | |
2439 ;; | |
2440 ;; for..loop | |
2441 ;; | |
2442 ((save-excursion | |
2443 (setq match-cons (ada-search-ignore-string-comment | |
2444 "\\<loop\\>" nil orgpoint))) | |
2445 (goto-char (car match-cons)) | |
2446 ;; | |
2447 ;; indent according to 'loop', if it's first in the line; | |
2448 ;; otherwise to 'for' | |
2449 ;; | |
2450 (if (not (save-excursion | |
2451 (back-to-indentation) | |
2452 (looking-at "\\<loop\\>"))) | |
2453 (goto-char pos)) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2454 (+ (current-indentation) ada-indent label)) |
10705 | 2455 ;; |
2456 ;; for-statement is broken | |
2457 ;; | |
2458 (t | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2459 (+ (current-indentation) ada-broken-indent label)))) |
10705 | 2460 |
2461 ;; | |
2462 ;; 'while'-loop | |
2463 ;; | |
2464 ((looking-at "while\\>") | |
2465 ;; | |
2466 ;; while..loop ? | |
2467 ;; | |
2468 (if (save-excursion | |
2469 (setq match-cons (ada-search-ignore-string-comment | |
2470 "\\<loop\\>" nil orgpoint))) | |
2471 | |
2472 (progn | |
2473 (goto-char (car match-cons)) | |
2474 ;; | |
2475 ;; indent according to 'loop', if it's first in the line; | |
2476 ;; otherwise to 'while'. | |
2477 ;; | |
2478 (if (not (save-excursion | |
2479 (back-to-indentation) | |
2480 (looking-at "\\<loop\\>"))) | |
2481 (goto-char pos)) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2482 (+ (current-indentation) ada-indent label)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2483 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2484 (+ (current-indentation) ada-broken-indent label)))))) |
10705 | 2485 |
2486 | |
2487 (defun ada-get-indent-type (orgpoint) | |
2488 ;; Returns the indentation (column #) for the new line after ORGPOINT. | |
2489 ;; Assumes point to be at the beginning of a type statement. | |
2490 (let ((match-dat nil)) | |
2491 (cond | |
2492 ;; | |
2493 ;; complete record declaration | |
2494 ;; | |
2495 ((save-excursion | |
2496 (and | |
2497 (setq match-dat (ada-search-ignore-string-comment "\\<end\\>" | |
2498 nil | |
2499 orgpoint)) | |
2500 (ada-goto-next-non-ws) | |
2501 (looking-at "\\<record\\>") | |
2502 (forward-word 1) | |
2503 (ada-goto-next-non-ws) | |
2504 (looking-at ";"))) | |
2505 (goto-char (car match-dat)) | |
2506 (current-indentation)) | |
2507 ;; | |
2508 ;; record type | |
2509 ;; | |
2510 ((save-excursion | |
2511 (setq match-dat (ada-search-ignore-string-comment "\\<record\\>" | |
2512 nil | |
2513 orgpoint))) | |
2514 (goto-char (car match-dat)) | |
2515 (+ (current-indentation) ada-indent)) | |
2516 ;; | |
2517 ;; complete type declaration | |
2518 ;; | |
2519 ((save-excursion | |
2520 (ada-search-ignore-string-comment ";" nil orgpoint)) | |
2521 (current-indentation)) | |
2522 ;; | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2523 ;; "type ... is", but not "type ... is ...", which is broken |
10705 | 2524 ;; |
2525 ((save-excursion | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2526 (and |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2527 (ada-search-ignore-string-comment "\\<is\\>" nil orgpoint) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2528 (not (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)))) |
10705 | 2529 (+ (current-indentation) ada-indent)) |
2530 ;; | |
2531 ;; broken statement | |
2532 ;; | |
2533 (t | |
2534 (+ (current-indentation) ada-broken-indent))))) | |
2535 | |
2536 | |
2537 ;;; ---- support-functions for indentation | |
2538 | |
2539 ;;; ---- searching and matching | |
2540 | |
2541 (defun ada-goto-stmt-start (&optional limit) | |
2542 ;; Moves point to the beginning of the statement that point is in or | |
2543 ;; after. Returns the new position of point. Beginnings are found | |
2544 ;; by searching for 'ada-end-stmt-re' and then moving to the | |
2545 ;; following non-ws that is not a comment. LIMIT is actually not | |
2546 ;; used by the indentation functions. | |
2547 (let ((match-dat nil) | |
2548 (orgpoint (point))) | |
2549 | |
2550 (setq match-dat (ada-search-prev-end-stmt limit)) | |
2551 (if match-dat | |
2552 ;; | |
2553 ;; found a previous end-statement => check if anything follows | |
2554 ;; | |
2555 (progn | |
2556 (if (not | |
2557 (save-excursion | |
2558 (goto-char (cdr match-dat)) | |
2559 (ada-search-ignore-string-comment | |
2560 "[^ \t\n]" nil orgpoint))) | |
2561 ;; | |
2562 ;; nothing follows => it's the end-statement directly in | |
2563 ;; front of point => search again | |
2564 ;; | |
2565 (setq match-dat (ada-search-prev-end-stmt limit))) | |
2566 ;; | |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
2567 ;; if found the correct end-statement => goto next non-ws |
10705 | 2568 ;; |
2569 (if match-dat | |
2570 (goto-char (cdr match-dat))) | |
2571 (ada-goto-next-non-ws)) | |
2572 | |
2573 ;; | |
2574 ;; no previous end-statement => we are at the beginning of the | |
2575 ;; accessible part of the buffer | |
2576 ;; | |
2577 (progn | |
2578 (goto-char (point-min)) | |
2579 ;; | |
2580 ;; skip to the very first statement, if there is one | |
2581 ;; | |
2582 (if (setq match-dat | |
2583 (ada-search-ignore-string-comment | |
2584 "[^ \t\n]" nil orgpoint)) | |
2585 (goto-char (car match-dat)) | |
2586 (goto-char orgpoint)))) | |
2587 | |
2588 | |
2589 (point))) | |
2590 | |
2591 | |
2592 (defun ada-search-prev-end-stmt (&optional limit) | |
2593 ;; Moves point to previous end-statement. Returns a cons cell whose | |
2594 ;; car is the beginning and whose cdr the end of the match. | |
2595 ;; End-statements are defined by 'ada-end-stmt-re'. Checks for | |
2596 ;; certain keywords if they follow 'end', which means they are no | |
2597 ;; end-statement there. | |
2598 (let ((match-dat nil) | |
2599 (pos nil) | |
2600 (found nil)) | |
2601 ;; | |
2602 ;; search until found or beginning-of-buffer | |
2603 ;; | |
2604 (while | |
2605 (and | |
2606 (not found) | |
2607 (setq match-dat (ada-search-ignore-string-comment ada-end-stmt-re | |
2608 t | |
2609 limit))) | |
2610 | |
2611 (goto-char (car match-dat)) | |
2612 (if (not (ada-in-open-paren-p)) | |
2613 ;; | |
2614 ;; check if there is an 'end' in front of the match | |
2615 ;; | |
2616 (if (not (and | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2617 (looking-at |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2618 "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>") |
10705 | 2619 (save-excursion |
2620 (ada-goto-previous-word) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2621 (looking-at "\\<\\(end\\|or\\|and\\)\\>")))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2622 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2623 (goto-char (cdr match-dat)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2624 (ada-goto-next-word) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2625 (if (not (looking-at "\\<\\(separate\\|new\\)\\>")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2626 (setq found t))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2627 |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
2628 (forward-word -1)))) ; end of loop |
10705 | 2629 |
2630 (if found | |
2631 match-dat | |
2632 nil))) | |
2633 | |
2634 | |
2635 (defun ada-goto-next-non-ws (&optional limit) | |
2636 ;; Skips whitespaces, newlines and comments to next non-ws | |
2637 ;; character. Signals an error if there is no more such character | |
2638 ;; and limit is nil. | |
2639 (let ((match-cons nil)) | |
2640 (setq match-cons (ada-search-ignore-string-comment | |
2641 "[^ \t\n]" nil limit t)) | |
2642 (if match-cons | |
2643 (goto-char (car match-cons)) | |
2644 (if (not limit) | |
2645 (error "no more non-ws") | |
2646 nil)))) | |
2647 | |
2648 | |
2649 (defun ada-goto-stmt-end (&optional limit) | |
2650 ;; Moves point to the end of the statement that point is in or | |
2651 ;; before. Returns the new position of point or nil if not found. | |
2652 (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit) | |
2653 (point) | |
2654 nil)) | |
2655 | |
2656 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2657 (defun ada-goto-next-word (&optional backward) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2658 ;; Moves point to the beginning of the next word of Ada code. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2659 ;; If BACKWARD is non-nil, jump to the beginning of the previous word. |
10705 | 2660 ;; Returns the new position of point or nil if not found. |
2661 (let ((match-cons nil) | |
2662 (orgpoint (point))) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2663 (if (not backward) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2664 (skip-chars-forward "_a-zA-Z0-9\\.")) |
10705 | 2665 (if (setq match-cons |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2666 (ada-search-ignore-string-comment "\\w" backward nil t)) |
10705 | 2667 ;; |
2668 ;; move to the beginning of the word found | |
2669 ;; | |
2670 (progn | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2671 (goto-char (car match-cons)) |
10705 | 2672 (skip-chars-backward "_a-zA-Z0-9") |
2673 (point)) | |
2674 ;; | |
2675 ;; if not found, restore old position of point | |
2676 ;; | |
2677 (progn | |
2678 (goto-char orgpoint) | |
2679 'nil)))) | |
2680 | |
2681 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2682 (defun ada-goto-previous-word () |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2683 ;; Moves point to the beginning of the previous word of Ada code. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2684 ;; Returns the new position of point or nil if not found. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2685 (ada-goto-next-word t)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2686 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2687 |
10705 | 2688 (defun ada-check-matching-start (keyword) |
2689 ;; Signals an error if matching block start is not KEYWORD. | |
2690 ;; Moves point to the matching block start. | |
2691 (ada-goto-matching-start 0) | |
2692 (if (not (looking-at (concat "\\<" keyword "\\>"))) | |
14415
db084c0ae4bd
(ada-indent-region, ada-check-matching-start, ada-check-defun-name): Fix error
Karl Heuer <kwzh@gnu.org>
parents:
14337
diff
changeset
|
2693 (error "matching start is not '%s'" keyword))) |
10705 | 2694 |
2695 | |
2696 (defun ada-check-defun-name (defun-name) | |
2697 ;; Checks if the name of the matching defun really is DEFUN-NAME. | |
2698 ;; Assumes point to be already positioned by 'ada-goto-matching-start'. | |
2699 ;; Moves point to the beginning of the declaration. | |
2700 | |
2701 ;; | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2702 ;; named block without a `declare' |
10705 | 2703 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2704 (if (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2705 (ada-goto-previous-word) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2706 (looking-at (concat "\\<" defun-name "\\> *:"))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2707 t ; do nothing |
10705 | 2708 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2709 ;; 'accept' or 'package' ? |
10705 | 2710 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2711 (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2712 (ada-goto-matching-decl-start)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2713 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2714 ;; 'begin' of 'procedure'/'function'/'task' or 'declare' |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2715 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2716 (save-excursion |
10705 | 2717 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2718 ;; a named 'declare'-block ? |
10705 | 2719 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2720 (if (looking-at "\\<declare\\>") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2721 (ada-goto-stmt-start) |
10705 | 2722 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2723 ;; no, => 'procedure'/'function'/'task'/'protected' |
10705 | 2724 ;; |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2725 (progn |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2726 (forward-word 2) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2727 (backward-word 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2728 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2729 ;; skip 'body' 'type' |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2730 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2731 (if (looking-at "\\<\\(body\\|type\\)\\>") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2732 (forward-word 1)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2733 (forward-sexp 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2734 (backward-sexp 1))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2735 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2736 ;; should be looking-at the correct name |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2737 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2738 (if (not (looking-at (concat "\\<" defun-name "\\>"))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2739 (error "matching defun has different name: %s" |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2740 (buffer-substring (point) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2741 (progn (forward-sexp 1) (point)))))))) |
10705 | 2742 |
2743 | |
2744 (defun ada-goto-matching-decl-start (&optional noerror nogeneric) | |
2745 ;; Moves point to the matching declaration start of the current 'begin'. | |
2746 ;; If NOERROR is non-nil, it only returns nil if no match was found. | |
2747 (let ((nest-count 1) | |
2748 (pos nil) | |
2749 (first t) | |
2750 (flag nil)) | |
2751 ;; | |
2752 ;; search backward for interesting keywords | |
2753 ;; | |
2754 (while (and | |
2755 (not (zerop nest-count)) | |
2756 (ada-search-ignore-string-comment | |
2757 (concat "\\<\\(" | |
2758 "is\\|separate\\|end\\|declare\\|new\\|begin\\|generic" | |
2759 "\\)\\>") t)) | |
2760 ;; | |
2761 ;; calculate nest-depth | |
2762 ;; | |
2763 (cond | |
2764 ;; | |
2765 ((looking-at "end") | |
2766 (ada-goto-matching-start 1 noerror) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2767 (if (looking-at "begin") |
10705 | 2768 (setq nest-count (1+ nest-count)))) |
2769 ;; | |
2770 ((looking-at "declare\\|generic") | |
2771 (setq nest-count (1- nest-count)) | |
2772 (setq first nil)) | |
2773 ;; | |
2774 ((looking-at "is") | |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
2775 ;; check if it is only a type definition, but not a protected |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
2776 ;; type definition, which should be handled like a procedure. |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2777 (if (or (looking-at "is +<>") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2778 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2779 (ada-goto-previous-word) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2780 (skip-chars-backward "a-zA-Z0-9_.'") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2781 (if (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2782 (backward-char 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2783 (looking-at ")")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2784 (progn |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2785 (forward-char 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2786 (backward-sexp 1) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2787 (skip-chars-backward "a-zA-Z0-9_.'") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2788 )) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2789 (ada-goto-previous-word) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2790 (and |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2791 (looking-at "\\<type\\>") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2792 (save-match-data |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2793 (ada-goto-previous-word) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2794 (not (looking-at "\\<protected\\>")))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2795 )); end of `or' |
10705 | 2796 (goto-char (match-beginning 0)) |
2797 (progn | |
2798 (setq nest-count (1- nest-count)) | |
2799 (setq first nil)))) | |
2800 | |
2801 ;; | |
2802 ((looking-at "new") | |
2803 (if (save-excursion | |
2804 (ada-goto-previous-word) | |
2805 (looking-at "is")) | |
2806 (goto-char (match-beginning 0)))) | |
2807 ;; | |
2808 ((and first | |
2809 (looking-at "begin")) | |
2810 (setq nest-count 0) | |
2811 (setq flag t)) | |
2812 ;; | |
2813 (t | |
2814 (setq nest-count (1+ nest-count)) | |
2815 (setq first nil))) | |
2816 | |
2817 ) ;; end of loop | |
2818 | |
2819 ;; check if declaration-start is really found | |
2820 (if (not | |
2821 (and | |
2822 (zerop nest-count) | |
2823 (not flag) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2824 (if (looking-at "is") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2825 (ada-search-ignore-string-comment ada-subprog-start-re t) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2826 (looking-at "declare\\|generic")))) |
10705 | 2827 (if noerror nil |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
2828 (error "no matching proc/func/task/declare/package/protected")) |
10705 | 2829 t))) |
2830 | |
2831 | |
2832 (defun ada-goto-matching-start (&optional nest-level noerror gotothen) | |
2833 ;; Moves point to the beginning of a block-start. Which block | |
2834 ;; depends on the value of NEST-LEVEL, which defaults to zero. If | |
2835 ;; NOERROR is non-nil, it only returns nil if no matching start was | |
2836 ;; found. If GOTOTHEN is non-nil, point moves to the 'then' | |
2837 ;; following 'if'. | |
2838 (let ((nest-count (if nest-level nest-level 0)) | |
2839 (found nil) | |
2840 (pos nil)) | |
2841 | |
2842 ;; | |
2843 ;; search backward for interesting keywords | |
2844 ;; | |
2845 (while (and | |
2846 (not found) | |
2847 (ada-search-ignore-string-comment | |
2848 (concat "\\<\\(" | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2849 "end\\|loop\\|select\\|begin\\|case\\|do\\|" |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
2850 "if\\|task\\|package\\|record\\|protected\\)\\>") |
10705 | 2851 t)) |
2852 | |
2853 ;; | |
2854 ;; calculate nest-depth | |
2855 ;; | |
2856 (cond | |
2857 ;; found block end => increase nest depth | |
2858 ((looking-at "end") | |
2859 (setq nest-count (1+ nest-count))) | |
2860 ;; found loop/select/record/case/if => check if it starts or | |
2861 ;; ends a block | |
2862 ((looking-at "loop\\|select\\|record\\|case\\|if") | |
2863 (setq pos (point)) | |
2864 (save-excursion | |
2865 ;; | |
2866 ;; check if keyword follows 'end' | |
2867 ;; | |
2868 (ada-goto-previous-word) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
2869 (if (looking-at "\\<end\\> *[^;]") |
10705 | 2870 ;; it ends a block => increase nest depth |
2871 (progn | |
2872 (setq nest-count (1+ nest-count)) | |
2873 (setq pos (point))) | |
2874 ;; it starts a block => decrease nest depth | |
2875 (setq nest-count (1- nest-count)))) | |
2876 (goto-char pos)) | |
2877 ;; found package start => check if it really is a block | |
2878 ((looking-at "package") | |
2879 (save-excursion | |
2880 (ada-search-ignore-string-comment "\\<is\\>") | |
2881 (ada-goto-next-non-ws) | |
2882 ;; ignore it if it is only a declaration with 'new' | |
2883 (if (not (looking-at "\\<new\\>")) | |
2884 (setq nest-count (1- nest-count))))) | |
2885 ;; found task start => check if it has a body | |
2886 ((looking-at "task") | |
2887 (save-excursion | |
2888 (forward-word 1) | |
2889 (ada-goto-next-non-ws) | |
2890 ;; ignore it if it has no body | |
2891 (if (not (looking-at "\\<body\\>")) | |
2892 (setq nest-count (1- nest-count))))) | |
2893 ;; all the other block starts | |
2894 (t | |
2895 (setq nest-count (1- nest-count)))) ; end of 'cond' | |
2896 | |
2897 ;; match is found, if nest-depth is zero | |
2898 ;; | |
2899 (setq found (zerop nest-count))) ; end of loop | |
2900 | |
2901 (if found | |
2902 ;; | |
2903 ;; match found => is there anything else to do ? | |
2904 ;; | |
2905 (progn | |
2906 (cond | |
2907 ;; | |
2908 ;; found 'if' => skip to 'then', if it's on a separate line | |
2909 ;; and GOTOTHEN is non-nil | |
2910 ;; | |
2911 ((and | |
2912 gotothen | |
2913 (looking-at "if") | |
2914 (save-excursion | |
2915 (ada-search-ignore-string-comment "\\<then\\>" nil nil) | |
2916 (back-to-indentation) | |
2917 (looking-at "\\<then\\>"))) | |
2918 (goto-char (match-beginning 0))) | |
2919 ;; | |
2920 ;; found 'do' => skip back to 'accept' | |
2921 ;; | |
2922 ((looking-at "do") | |
2923 (if (not (ada-search-ignore-string-comment "\\<accept\\>" t nil)) | |
2924 (error "missing 'accept' in front of 'do'")))) | |
2925 (point)) | |
2926 | |
2927 (if noerror | |
2928 nil | |
2929 (error "no matching start"))))) | |
2930 | |
2931 | |
2932 (defun ada-goto-matching-end (&optional nest-level noerror) | |
2933 ;; Moves point to the end of a block. Which block depends on the | |
2934 ;; value of NEST-LEVEL, which defaults to zero. If NOERROR is | |
2935 ;; non-nil, it only returns nil if found no matching start. | |
2936 (let ((nest-count (if nest-level nest-level 0)) | |
2937 (found nil)) | |
2938 | |
2939 ;; | |
2940 ;; search forward for interesting keywords | |
2941 ;; | |
2942 (while (and | |
2943 (not found) | |
2944 (ada-search-ignore-string-comment | |
2945 (concat "\\<\\(end\\|loop\\|select\\|begin\\|case\\|" | |
2946 "if\\|task\\|package\\|record\\|do\\)\\>"))) | |
2947 | |
2948 ;; | |
2949 ;; calculate nest-depth | |
2950 ;; | |
2951 (backward-word 1) | |
2952 (cond | |
2953 ;; found block end => decrease nest depth | |
2954 ((looking-at "\\<end\\>") | |
2955 (setq nest-count (1- nest-count)) | |
2956 ;; skip the following keyword | |
2957 (if (progn | |
2958 (skip-chars-forward "end") | |
2959 (ada-goto-next-non-ws) | |
2960 (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>")) | |
2961 (forward-word 1))) | |
2962 ;; found package start => check if it really starts a block | |
2963 ((looking-at "\\<package\\>") | |
2964 (ada-search-ignore-string-comment "\\<is\\>") | |
2965 (ada-goto-next-non-ws) | |
2966 ;; ignore and skip it if it is only a 'new' package | |
2967 (if (not (looking-at "\\<new\\>")) | |
2968 (setq nest-count (1+ nest-count)) | |
2969 (skip-chars-forward "new"))) | |
2970 ;; all the other block starts | |
2971 (t | |
2972 (setq nest-count (1+ nest-count)) | |
2973 (forward-word 1))) ; end of 'cond' | |
2974 | |
2975 ;; match is found, if nest-depth is zero | |
2976 ;; | |
2977 (setq found (zerop nest-count))) ; end of loop | |
2978 | |
2979 (if (not found) | |
2980 (if noerror | |
2981 nil | |
2982 (error "no matching end")) | |
2983 t))) | |
2984 | |
2985 | |
2986 (defun ada-forward-sexp-ignore-comment () | |
2987 ;; Skips one sexp forward, ignoring comments. | |
2988 (while (looking-at "[ \t\n]*--") | |
2989 (skip-chars-forward "[ \t\n]") | |
2990 (end-of-line)) | |
2991 (forward-sexp 1)) | |
2992 | |
2993 | |
2994 (defun ada-search-ignore-string-comment | |
2995 (search-re &optional backward limit paramlists) | |
2996 ;; Regexp-Search for SEARCH-RE, ignoring comments, strings and | |
2997 ;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of | |
2998 ;; begin and end of match data or nil, if not found. | |
2999 (let ((found nil) | |
3000 (begin nil) | |
3001 (end nil) | |
3002 (pos nil) | |
3003 (search-func | |
3004 (if backward 're-search-backward | |
3005 're-search-forward))) | |
3006 | |
3007 ;; | |
3008 ;; search until found or end-of-buffer | |
3009 ;; | |
3010 (while (and (not found) | |
3011 (funcall search-func search-re limit 1)) | |
3012 (setq begin (match-beginning 0)) | |
3013 (setq end (match-end 0)) | |
3014 | |
3015 (cond | |
3016 ;; | |
3017 ;; found in comment => skip it | |
3018 ;; | |
3019 ((ada-in-comment-p) | |
3020 (if backward | |
3021 (progn | |
3022 (re-search-backward "--" nil 1) | |
3023 (goto-char (match-beginning 0))) | |
3024 (progn | |
3025 (forward-line 1) | |
3026 (beginning-of-line)))) | |
3027 ;; | |
3028 ;; found in string => skip it | |
3029 ;; | |
3030 ((ada-in-string-p) | |
3031 (if backward | |
3032 (progn | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3033 (re-search-backward "\"" nil 1) ; "\"\\|#" don't treat # |
10705 | 3034 (goto-char (match-beginning 0)))) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3035 (re-search-forward "\"" nil 1)) |
10705 | 3036 ;; |
3037 ;; found character constant => ignore it | |
3038 ;; | |
3039 ((save-excursion | |
3040 (setq pos (- (point) (if backward 1 2))) | |
3041 (and (char-after pos) | |
3042 (= (char-after pos) ?') | |
3043 (= (char-after (+ pos 2)) ?'))) | |
3044 ()) | |
3045 ;; | |
3046 ;; found a parameter-list but should ignore it => skip it | |
3047 ;; | |
3048 ((and (not paramlists) | |
3049 (ada-in-paramlist-p)) | |
3050 (if backward | |
3051 (ada-search-ignore-string-comment "(" t nil t))) | |
3052 ;; | |
3053 ;; directly in front of a comment => skip it, if searching forward | |
3054 ;; | |
3055 ((save-excursion | |
3056 (goto-char begin) | |
3057 (looking-at "--")) | |
3058 (if (not backward) | |
3059 (progn | |
3060 (forward-line 1) | |
3061 (beginning-of-line)))) | |
3062 ;; | |
3063 ;; found what we were looking for | |
3064 ;; | |
3065 (t | |
3066 (setq found t)))) ; end of loop | |
3067 | |
3068 (if found | |
3069 (cons begin end) | |
3070 nil))) | |
3071 | |
3072 | |
3073 (defun ada-search-but-not (search-re not-search-re &optional backward limit) | |
3074 ;; Searches SEARCH-RE, ignoring parts of NOT-SEARCH-RE, strings, | |
3075 ;; comments and parameter-lists. | |
3076 (let ((begin nil) | |
3077 (end nil) | |
3078 (begin-not nil) | |
3079 (begin-end nil) | |
3080 (end-not nil) | |
3081 (ret-cons nil) | |
3082 (found nil)) | |
3083 | |
3084 ;; | |
3085 ;; search until found or end-of-buffer | |
3086 ;; | |
3087 (while (and | |
3088 (not found) | |
3089 (save-excursion | |
3090 (setq ret-cons | |
3091 (ada-search-ignore-string-comment search-re | |
3092 backward limit)) | |
3093 (if (consp ret-cons) | |
3094 (progn | |
3095 (setq begin (car ret-cons)) | |
3096 (setq end (cdr ret-cons)) | |
3097 t) | |
3098 nil))) | |
3099 | |
3100 (if (or | |
3101 ;; | |
3102 ;; if no NO-SEARCH-RE was found | |
3103 ;; | |
3104 (not | |
3105 (save-excursion | |
3106 (setq ret-cons | |
3107 (ada-search-ignore-string-comment not-search-re | |
3108 backward nil)) | |
3109 (if (consp ret-cons) | |
3110 (progn | |
3111 (setq begin-not (car ret-cons)) | |
3112 (setq end-not (cdr ret-cons)) | |
3113 t) | |
3114 nil))) | |
3115 ;; | |
3116 ;; or this NO-SEARCH-RE is not a part of the SEARCH-RE | |
3117 ;; found before. | |
3118 ;; | |
3119 (or | |
3120 (<= end-not begin) | |
3121 (>= begin-not end))) | |
3122 | |
3123 (setq found t) | |
3124 | |
3125 ;; | |
3126 ;; not found the correct match => skip this match | |
3127 ;; | |
3128 (goto-char (if backward | |
3129 begin | |
3130 end)))) ; end of loop | |
3131 | |
3132 (if found | |
3133 (progn | |
3134 (goto-char begin) | |
3135 (cons begin end)) | |
3136 nil))) | |
3137 | |
3138 | |
3139 (defun ada-goto-prev-nonblank-line ( &optional ignore-comment) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3140 ;; Moves point to the beginning of previous non-blank line, |
10705 | 3141 ;; ignoring comments if IGNORE-COMMENT is non-nil. |
3142 ;; It returns t if a matching line was found. | |
3143 (let ((notfound t) | |
3144 (newpoint nil)) | |
3145 | |
3146 (save-excursion | |
3147 ;; | |
3148 ;; backward one line, if there is one | |
3149 ;; | |
3150 (if (zerop (forward-line -1)) | |
3151 ;; | |
3152 ;; there is some kind of previous line | |
3153 ;; | |
3154 (progn | |
3155 (beginning-of-line) | |
3156 (setq newpoint (point)) | |
3157 | |
3158 ;; | |
3159 ;; search until found or beginning-of-buffer | |
3160 ;; | |
3161 (while (and (setq notfound | |
3162 (or (looking-at "[ \t]*$") | |
3163 (and (looking-at "[ \t]*--") | |
3164 ignore-comment))) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3165 (not (ada-in-limit-line-p))) |
10705 | 3166 (forward-line -1) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3167 ;;(beginning-of-line) |
10705 | 3168 (setq newpoint (point))) ; end of loop |
3169 | |
3170 )) ; end of if | |
3171 | |
3172 ) ; end of save-excursion | |
3173 | |
3174 (if notfound nil | |
3175 (progn | |
3176 (goto-char newpoint) | |
3177 t)))) | |
3178 | |
3179 | |
3180 (defun ada-goto-next-nonblank-line ( &optional ignore-comment) | |
3181 ;; Moves point to next non-blank line, | |
3182 ;; ignoring comments if IGNORE-COMMENT is non-nil. | |
3183 ;; It returns t if a matching line was found. | |
3184 (let ((notfound t) | |
3185 (newpoint nil)) | |
3186 | |
3187 (save-excursion | |
3188 ;; | |
3189 ;; forward one line | |
3190 ;; | |
3191 (if (zerop (forward-line 1)) | |
3192 ;; | |
3193 ;; there is some kind of previous line | |
3194 ;; | |
3195 (progn | |
3196 (beginning-of-line) | |
3197 (setq newpoint (point)) | |
3198 | |
3199 ;; | |
3200 ;; search until found or end-of-buffer | |
3201 ;; | |
3202 (while (and (setq notfound | |
3203 (or (looking-at "[ \t]*$") | |
3204 (and (looking-at "[ \t]*--") | |
3205 ignore-comment))) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3206 (not (ada-in-limit-line-p))) |
10705 | 3207 (forward-line 1) |
3208 (beginning-of-line) | |
3209 (setq newpoint (point))) ; end of loop | |
3210 | |
3211 )) ; end of if | |
3212 | |
3213 ) ; end of save-excursion | |
3214 | |
3215 (if notfound nil | |
3216 (progn | |
3217 (goto-char newpoint) | |
3218 t)))) | |
3219 | |
3220 | |
3221 ;; ---- boolean functions for indentation | |
3222 | |
3223 (defun ada-in-decl-p () | |
3224 ;; Returns t if point is inside a declarative part. | |
3225 ;; Assumes point to be at the end of a statement. | |
3226 (or | |
3227 (ada-in-paramlist-p) | |
3228 (save-excursion | |
3229 (ada-goto-matching-decl-start t)))) | |
3230 | |
3231 | |
3232 (defun ada-looking-at-semi-or () | |
3233 ;; Returns t if looking-at an 'or' following a semicolon. | |
3234 (save-excursion | |
3235 (and (looking-at "\\<or\\>") | |
3236 (progn | |
3237 (forward-word 1) | |
3238 (ada-goto-stmt-start) | |
3239 (looking-at "\\<or\\>"))))) | |
3240 | |
3241 | |
3242 (defun ada-looking-at-semi-private () | |
3243 ;; Returns t if looking-at an 'private' following a semicolon. | |
3244 (save-excursion | |
3245 (and (looking-at "\\<private\\>") | |
3246 (progn | |
3247 (forward-word 1) | |
3248 (ada-goto-stmt-start) | |
3249 (looking-at "\\<private\\>"))))) | |
3250 | |
3251 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3252 ;;; make a faster??? ada-in-limit-line-p not using count-lines |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3253 (defun ada-in-limit-line-p () |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3254 ;; return t if point is in first or last accessible line. |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3255 (or (save-excursion (beginning-of-line) (= (point-min) (point))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3256 (save-excursion (end-of-line) (= (point-max) (point))))) |
10705 | 3257 |
3258 | |
3259 (defun ada-in-comment-p () | |
3260 ;; Returns t if inside a comment. | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3261 (nth 4 (parse-partial-sexp |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3262 (save-excursion (beginning-of-line) (point)) |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3263 (point)))) |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3264 |
10705 | 3265 |
3266 (defun ada-in-string-p () | |
3267 ;; Returns t if point is inside a string | |
3268 ;; (Taken from pascal-mode.el, modified by MH). | |
3269 (save-excursion | |
3270 (and | |
3271 (nth 3 (parse-partial-sexp | |
3272 (save-excursion | |
3273 (beginning-of-line) | |
3274 (point)) (point))) | |
3275 ;; check if 'string quote' is only a character constant | |
3276 (progn | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3277 (re-search-backward "\"" nil t) ; `#' is not taken as a string delimiter |
10705 | 3278 (not (= (char-after (1- (point))) ?')))))) |
3279 | |
3280 | |
3281 (defun ada-in-string-or-comment-p () | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3282 ;; Returns t if point is inside a string, a comment, or a character constant. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3283 (let ((parse-result (parse-partial-sexp |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3284 (save-excursion (beginning-of-line) (point)) (point)))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3285 (or ;; in-comment-p |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3286 (nth 4 parse-result) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3287 ;; in-string-p |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3288 (and |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3289 (nth 3 parse-result) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3290 ;; check if 'string quote' is only a character constant |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3291 (progn |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3292 (re-search-backward "\"" nil t) ; `#' not regarded a string delimiter |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3293 (not (= (char-after (1- (point))) ?')))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3294 ;; in-char-const-p |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3295 (ada-in-char-const-p)))) |
10705 | 3296 |
3297 | |
3298 (defun ada-in-paramlist-p () | |
3299 ;; Returns t if point is inside a parameter-list | |
3300 ;; following 'function'/'procedure'/'package'. | |
3301 (save-excursion | |
3302 (and | |
3303 (re-search-backward "(\\|)" nil t) | |
3304 ;; inside parentheses ? | |
3305 (looking-at "(") | |
3306 (backward-word 2) | |
13963
a62c62ac5102
(ada-case-keyword, ada-auto-case, ada-krunch-args,
Karl Heuer <kwzh@gnu.org>
parents:
13337
diff
changeset
|
3307 ;; right keyword before parenthesis ? |
10705 | 3308 (looking-at (concat "\\<\\(" |
3309 "procedure\\|function\\|body\\|package\\|" | |
3310 "task\\|entry\\|accept\\)\\>")) | |
3311 (re-search-forward ")\\|:" nil t) | |
3312 ;; at least one ':' inside the parentheses ? | |
3313 (not (backward-char 1)) | |
3314 (looking-at ":")))) | |
3315 | |
3316 | |
3317 ;; not really a boolean function ... | |
3318 (defun ada-in-open-paren-p () | |
3319 ;; If point is somewhere behind an open parenthesis not yet closed, | |
3320 ;; it returns the column # of the first non-ws behind this open | |
3321 ;; parenthesis, otherwise nil." | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3322 (let ((start (if (<= (point) ada-search-paren-char-count-limit) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3323 (point-min) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3324 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3325 (goto-char (- (point) ada-search-paren-char-count-limit)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3326 (beginning-of-line) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3327 (point)))) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3328 parse-result |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3329 (col nil)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3330 (setq parse-result (parse-partial-sexp start (point))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3331 (if (nth 1 parse-result) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3332 (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3333 (goto-char (1+ (nth 1 parse-result))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3334 (if (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3335 (re-search-forward "[^ \t]" nil 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3336 (backward-char 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3337 (and |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3338 (not (looking-at "\n")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3339 (setq col (current-column)))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3340 col |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3341 (current-column))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3342 nil))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3343 |
10705 | 3344 |
3345 | |
3346 ;;;----------------------;;; | |
3347 ;;; Behaviour Of TAB Key ;;; | |
3348 ;;;----------------------;;; | |
3349 | |
3350 (defun ada-tab () | |
3351 "Do indenting or tabbing according to `ada-tab-policy'." | |
3352 (interactive) | |
3353 (cond ((eq ada-tab-policy 'indent-and-tab) (error "not implemented")) | |
3354 ;; ada-indent-and-tab | |
3355 ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard)) | |
3356 ((eq ada-tab-policy 'indent-auto) (ada-indent-current)) | |
3357 ((eq ada-tab-policy 'gei) (ada-tab-gei)) | |
3358 ((eq ada-tab-policy 'indent-af) (af-indent-line)) ; GEB | |
3359 ((eq ada-tab-policy 'always-tab) (error "not implemented")) | |
3360 )) | |
3361 | |
3362 | |
3363 (defun ada-untab (arg) | |
3364 "Delete leading indenting according to `ada-tab-policy'." | |
3365 (interactive "P") | |
3366 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard)) | |
3367 ((eq ada-tab-policy 'indent-af) (backward-delete-char-untabify ; GEB | |
3368 (prefix-numeric-value arg) ; GEB | |
3369 arg)) ; GEB | |
3370 ((eq ada-tab-policy 'indent-auto) (error "not implemented")) | |
3371 ((eq ada-tab-policy 'always-tab) (error "not implemented")) | |
3372 )) | |
3373 | |
3374 | |
3375 (defun ada-indent-current-function () | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3376 "Ada mode version of the indent-line-function." |
10705 | 3377 (interactive "*") |
3378 (let ((starting-point (point-marker))) | |
3379 (ada-beginning-of-line) | |
3380 (ada-tab) | |
3381 (if (< (point) starting-point) | |
3382 (goto-char starting-point)) | |
3383 (set-marker starting-point nil) | |
3384 )) | |
3385 | |
3386 | |
3387 (defun ada-tab-hard () | |
3388 "Indent current line to next tab stop." | |
3389 (interactive) | |
3390 (save-excursion | |
3391 (beginning-of-line) | |
3392 (insert-char ? ada-indent)) | |
3393 (if (save-excursion (= (point) (progn (beginning-of-line) (point)))) | |
3394 (forward-char ada-indent))) | |
3395 | |
3396 | |
3397 (defun ada-untab-hard () | |
3398 "indent current line to previous tab stop." | |
3399 (interactive) | |
3400 (let ((bol (save-excursion (progn (beginning-of-line) (point)))) | |
3401 (eol (save-excursion (progn (end-of-line) (point))))) | |
3402 (indent-rigidly bol eol (- 0 ada-indent)))) | |
3403 | |
3404 | |
3405 | |
3406 ;;;---------------;;; | |
3407 ;;; Miscellaneous ;;; | |
3408 ;;;---------------;;; | |
3409 | |
3410 (defun ada-remove-trailing-spaces () | |
3411 "remove trailing spaces in the whole buffer." | |
3412 (interactive) | |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
3413 (save-match-data |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3414 (save-excursion |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
3415 (save-restriction |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
3416 (widen) |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3417 (goto-char (point-min)) |
12586
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
3418 (while (re-search-forward "[ \t]+$" (point-max) t) |
f8bbc7a3b87a
(ada-ident-re): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12053
diff
changeset
|
3419 (replace-match "" nil nil)))))) |
10705 | 3420 |
3421 | |
3422 (defun ada-untabify-buffer () | |
3423 ;; change all tabs to spaces | |
3424 (save-excursion | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3425 (untabify (point-min) (point-max)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3426 nil)) |
10705 | 3427 |
3428 | |
3429 (defun ada-uncomment-region (beg end) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3430 "delete `comment-start' at the beginning of a line in the region." |
10705 | 3431 (interactive "r") |
3432 (comment-region beg end -1)) | |
3433 | |
3434 | |
3435 ;; define a function to support find-file.el if loaded | |
3436 (defun ada-ff-other-window () | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3437 "Find other file in other window using `ff-find-other-file'." |
10705 | 3438 (interactive) |
3439 (and (fboundp 'ff-find-other-file) | |
3440 (ff-find-other-file t))) | |
3441 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3442 ;; inspired by Laurent.GUERBY@enst-bretagne.fr |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3443 (defun ada-gnat-style () |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3444 "Clean up comments, `(' and `,' for GNAT style checking switch." |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3445 (interactive) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3446 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3447 (goto-char (point-min)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3448 (while (re-search-forward "-- ?\\([^ -]\\)" nil t) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3449 (replace-match "-- \\1")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3450 (goto-char (point-min)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3451 (while (re-search-forward "\\>(" nil t) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3452 (replace-match " (")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3453 (goto-char (point-min)) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3454 (while (re-search-forward ",\\<" nil t) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3455 (replace-match ", ")) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3456 )) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3457 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3458 |
10705 | 3459 |
3460 ;;;-------------------------------;;; | |
3461 ;;; Moving To Procedures/Packages ;;; | |
3462 ;;;-------------------------------;;; | |
3463 | |
3464 (defun ada-next-procedure () | |
3465 "Moves point to next procedure." | |
3466 (interactive) | |
3467 (end-of-line) | |
3468 (if (re-search-forward ada-procedure-start-regexp nil t) | |
3469 (goto-char (match-beginning 1)) | |
3470 (error "No more functions/procedures/tasks"))) | |
3471 | |
3472 (defun ada-previous-procedure () | |
3473 "Moves point to previous procedure." | |
3474 (interactive) | |
3475 (beginning-of-line) | |
3476 (if (re-search-backward ada-procedure-start-regexp nil t) | |
3477 (goto-char (match-beginning 1)) | |
3478 (error "No more functions/procedures/tasks"))) | |
3479 | |
3480 (defun ada-next-package () | |
3481 "Moves point to next package." | |
3482 (interactive) | |
3483 (end-of-line) | |
3484 (if (re-search-forward ada-package-start-regexp nil t) | |
3485 (goto-char (match-beginning 1)) | |
3486 (error "No more packages"))) | |
3487 | |
3488 (defun ada-previous-package () | |
3489 "Moves point to previous package." | |
3490 (interactive) | |
3491 (beginning-of-line) | |
3492 (if (re-search-backward ada-package-start-regexp nil t) | |
3493 (goto-char (match-beginning 1)) | |
3494 (error "No more packages"))) | |
3495 | |
3496 | |
3497 ;;;----------------------- | |
3498 ;;; define keymap for Ada | |
3499 ;;;----------------------- | |
3500 | |
3501 (if (not ada-mode-map) | |
3502 (progn | |
3503 (setq ada-mode-map (make-sparse-keymap)) | |
3504 | |
3505 ;; Indentation and Formatting | |
3506 (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent) | |
3507 (define-key ada-mode-map "\t" 'ada-tab) | |
3508 (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region) | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3509 (if (ada-xemacs) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3510 (define-key ada-mode-map '(shift tab) 'ada-untab) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3511 (define-key ada-mode-map [S-tab] 'ada-untab)) |
10705 | 3512 (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist) |
3513 (define-key ada-mode-map "\C-c\C-p" 'ada-call-pretty-printer) | |
10707 | 3514 ;;; We don't want to make meta-characters case-specific. |
3515 ;;; (define-key ada-mode-map "\M-Q" 'ada-fill-comment-paragraph-justify) | |
10705 | 3516 (define-key ada-mode-map "\M-\C-q" 'ada-fill-comment-paragraph-postfix) |
3517 | |
3518 ;; Movement | |
10707 | 3519 ;;; It isn't good to redefine these. What should be done instead? -- rms. |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3520 ;;; (define-key ada-mode-map "\M-e" 'ada-next-package) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3521 ;;; (define-key ada-mode-map "\M-a" 'ada-previous-package) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3522 (define-key ada-mode-map "\M-\C-e" 'ada-next-procedure) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3523 (define-key ada-mode-map "\M-\C-a" 'ada-previous-procedure) |
10705 | 3524 (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start) |
3525 (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end) | |
3526 | |
3527 ;; Compilation | |
3528 (define-key ada-mode-map "\C-c\C-c" 'compile) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3529 (define-key ada-mode-map "\C-c\C-v" 'ada-check-syntax) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3530 (define-key ada-mode-map "\C-c\C-m" 'ada-make-local) |
10705 | 3531 |
3532 ;; Casing | |
3533 (define-key ada-mode-map "\C-c\C-r" 'ada-adjust-case-region) | |
3534 (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer) | |
3535 | |
3536 (define-key ada-mode-map "\177" 'backward-delete-char-untabify) | |
3537 | |
3538 ;; Use predefined function of emacs19 for comments (RE) | |
3539 (define-key ada-mode-map "\C-c;" 'comment-region) | |
3540 (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) | |
3541 | |
3542 ;; Change basic functionality | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3543 |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3544 ;; `substitute-key-definition' is not defined equally in Emacs |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3545 ;; and XEmacs, you cannot put in an optional 4th parameter in |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3546 ;; XEmacs. I don't think it's necessary, so I leave it out for |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3547 ;; Emacs as well. If you encounter any problems with the |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3548 ;; following three functions, please tell me. RE |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3549 (mapcar (function (lambda (pair) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3550 (substitute-key-definition (car pair) (cdr pair) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3551 ada-mode-map))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3552 '((beginning-of-line . ada-beginning-of-line) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3553 (end-of-line . ada-end-of-line) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3554 (forward-to-indentation . ada-forward-to-indentation) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3555 )) |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3556 ;; else Emacs |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3557 ;;(mapcar (lambda (pair) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3558 ;; (substitute-key-definition (car pair) (cdr pair) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3559 ;; ada-mode-map global-map)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3560 |
10705 | 3561 )) |
3562 | |
3563 | |
3564 ;;;------------------- | |
3565 ;;; define menu 'Ada' | |
3566 ;;;------------------- | |
3567 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3568 (require 'easymenu) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3569 |
10705 | 3570 (defun ada-add-ada-menu () |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3571 "Adds the menu 'Ada' to the menu bar in Ada mode." |
11869
ab2739454f2a
(ada-add-ada-menu): Fix args to easy-menu-define.
Karl Heuer <kwzh@gnu.org>
parents:
11231
diff
changeset
|
3572 (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode." |
10705 | 3573 '("Ada" |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3574 ["Next Package" ada-next-package t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3575 ["Previous Package" ada-previous-package t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3576 ["Next Procedure" ada-next-procedure t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3577 ["Previous Procedure" ada-previous-procedure t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3578 ["Goto Start" ada-move-to-start t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3579 ["Goto End" ada-move-to-end t] |
10705 | 3580 ["------------------" nil nil] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3581 ["Indent Current Line (TAB)" |
10705 | 3582 ada-indent-current-function t] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3583 ["Indent Lines in Region" ada-indent-region t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3584 ["Format Parameter List" ada-format-paramlist t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3585 ["Pretty Print Buffer" ada-call-pretty-printer t] |
10705 | 3586 ["------------" nil nil] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3587 ["Fill Comment Paragraph" |
10705 | 3588 ada-fill-comment-paragraph t] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3589 ["Justify Comment Paragraph" |
10705 | 3590 ada-fill-comment-paragraph-justify t] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3591 ["Postfix Comment Paragraph" |
10705 | 3592 ada-fill-comment-paragraph-postfix t] |
3593 ["------------" nil nil] | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3594 ["Adjust Case Region" ada-adjust-case-region t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3595 ["Adjust Case Buffer" ada-adjust-case-buffer t] |
10705 | 3596 ["----------" nil nil] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3597 ["Comment Region" comment-region t] |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3598 ["Uncomment Region" ada-uncomment-region t] |
10705 | 3599 ["----------------" nil nil] |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3600 ["Global Make" compile (fboundp 'compile)] |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3601 ["Local Make" ada-make-local t] |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3602 ["Check Syntax" ada-check-syntax t] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3603 ["Next Error" next-error (fboundp 'next-error)] |
10705 | 3604 ["---------------" nil nil] |
3605 ["Index" imenu (fboundp 'imenu)] | |
3606 ["--------------" nil nil] | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3607 ["Other File Other Window" ada-ff-other-window |
10705 | 3608 (fboundp 'ff-find-other-file)] |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3609 ["Other File" ff-find-other-file |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3610 (fboundp 'ff-find-other-file)])) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3611 (if (ada-xemacs) (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3612 (easy-menu-add ada-mode-menu) |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3613 (setq mode-popup-menu (cons "Ada mode" ada-mode-menu))))) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3614 |
10705 | 3615 |
3616 | |
3617 ;;;------------------------------- | |
3618 ;;; Define Some Support Functions | |
3619 ;;;------------------------------- | |
3620 | |
3621 (defun ada-beginning-of-line (&optional arg) | |
3622 (interactive "P") | |
3623 (cond | |
3624 ((eq ada-tab-policy 'indent-af) (af-beginning-of-line arg)) | |
3625 (t (beginning-of-line arg)) | |
3626 )) | |
3627 | |
3628 (defun ada-end-of-line (&optional arg) | |
3629 (interactive "P") | |
3630 (cond | |
3631 ((eq ada-tab-policy 'indent-af) (af-end-of-line arg)) | |
3632 (t (end-of-line arg)) | |
3633 )) | |
3634 | |
3635 (defun ada-current-column () | |
3636 (cond | |
3637 ((eq ada-tab-policy 'indent-af) (af-current-column)) | |
3638 (t (current-column)) | |
3639 )) | |
3640 | |
3641 (defun ada-forward-to-indentation (&optional arg) | |
3642 (interactive "P") | |
3643 (cond | |
3644 ((eq ada-tab-policy 'indent-af) (af-forward-to-indentation arg)) | |
3645 (t (forward-to-indentation arg)) | |
3646 )) | |
3647 | |
3648 ;;;--------------------------------------------------- | |
17929 | 3649 ;;; support for find-file.el |
10705 | 3650 ;;;--------------------------------------------------- |
3651 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3652 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3653 ;;;###autoload |
10705 | 3654 (defun ada-make-filename-from-adaname (adaname) |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3655 "Determine the filename of a package/procedure from its own Ada name." |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3656 ;; this is done simply by calling `gnatkr', when we work with GNAT. It |
10705 | 3657 ;; must be a more complex function in other compiler environments. |
3658 (interactive "s") | |
3659 (let (krunch-buf) | |
3660 (setq krunch-buf (generate-new-buffer "*gkrunch*")) | |
3661 (save-excursion | |
3662 (set-buffer krunch-buf) | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3663 ;; send adaname to external process `gnatkr'. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3664 (call-process "gnatkr" nil krunch-buf nil |
10705 | 3665 adaname ada-krunch-args) |
3666 ;; fetch output of that process | |
3667 (setq adaname (buffer-substring | |
3668 (point-min) | |
3669 (progn | |
3670 (goto-char (point-min)) | |
3671 (end-of-line) | |
3672 (point)))) | |
3673 (kill-buffer krunch-buf))) | |
3674 (setq adaname adaname) ;; can I avoid this statement? | |
3675 ) | |
3676 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3677 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3678 ;;; functions for placing the cursor on the corresponding subprogram |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3679 (defun ada-which-function-are-we-in () |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3680 "Determine whether we are on a function definition/declaration. |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3681 If that is the case remember the name of that function." |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3682 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3683 (setq ff-function-name nil) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3684 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3685 (save-excursion |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3686 (if (re-search-backward ada-procedure-start-regexp nil t) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3687 (setq ff-function-name (buffer-substring (match-beginning 0) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3688 (match-end 0))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3689 ; we didn't find a procedure start, perhaps there is a package |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3690 (if (re-search-backward ada-package-start-regexp nil t) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3691 (setq ff-function-name (buffer-substring (match-beginning 0) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3692 (match-end 0))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3693 )))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3694 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3695 |
10705 | 3696 ;;;--------------------------------------------------- |
3697 ;;; support for font-lock | |
3698 ;;;--------------------------------------------------- | |
3699 | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3700 ;; Strings are a real pain in Ada because a single quote character is |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3701 ;; overloaded as a string quote and type/instance delimiter. By default, a |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3702 ;; single quote is given punctuation syntax in `ada-mode-syntax-table'. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3703 ;; So, for Font Lock mode purposes, we mark single quotes as having string |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3704 ;; syntax when the gods that created Ada determine them to be. sm. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3705 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3706 (defconst ada-font-lock-syntactic-keywords |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3707 ;; Mark single quotes as having string quote syntax in 'c' instances. |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3708 '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\'))))) |
10705 | 3709 |
3710 (defconst ada-font-lock-keywords-1 | |
3711 (list | |
3712 ;; | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3713 ;; handle "type T is access function return S;" |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3714 ;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3715 (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) ) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3716 ;; |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3717 ;; accept, entry, function, package (body), protected (body|type), |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3718 ;; pragma, procedure, task (body) plus name. |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3719 (list (concat |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3720 "\\<\\(" |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3721 "accept\\|" |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3722 "entry\\|" |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3723 "function\\|" |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3724 "package[ \t]+body\\|" |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3725 "package\\|" |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3726 "pragma\\|" |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3727 "procedure\\|" |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3728 "protected[ \t]+body\\|" |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3729 "protected[ \t]+type\\|" |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3730 "protected\\|" |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3731 ;; "p\\(\\(ackage\\|rotected\\)\\(\\|[ \t]+\\(body\\|type\\)\\)\ |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3732 ;;\\|r\\(agma\\|ocedure\\)\\)\\|" |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3733 "task[ \t]+body\\|" |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3734 "task[ \t]+type\\|" |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3735 "task" |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3736 ;; "task\\(\\|[ \t]+body\\)" |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3737 "\\)\\>[ \t]*" |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3738 "\\(\\sw+\\(\\.\\sw*\\)*\\)?") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3739 '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))) |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3740 "Subdued level highlighting for Ada mode.") |
10705 | 3741 |
3742 (defconst ada-font-lock-keywords-2 | |
3743 (append ada-font-lock-keywords-1 | |
3744 (list | |
3745 ;; | |
3746 ;; Main keywords, except those treated specially below. | |
3747 (concat "\\<\\(" | |
3748 ; ("abort" "abs" "abstract" "accept" "access" "aliased" "all" | |
3749 ; "and" "array" "at" "begin" "case" "declare" "delay" "delta" | |
3750 ; "digits" "do" "else" "elsif" "entry" "exception" "exit" "for" | |
3751 ; "generic" "if" "in" "is" "limited" "loop" "mod" "not" | |
3752 ; "null" "or" "others" "private" "protected" | |
3753 ; "range" "record" "rem" "renames" "requeue" "return" "reverse" | |
3754 ; "select" "separate" "tagged" "task" "terminate" "then" "until" | |
3755 ; "while" "xor") | |
3756 "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|" | |
3757 "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|" | |
3758 "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|" | |
3759 "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|" | |
3760 "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|" | |
3761 "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|" | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3762 "r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|" |
10705 | 3763 "se\\(lect\\|parate\\)\\|" |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3764 "t\\(agged\\|erminate\\|hen\\)\\|until\\|" ; task removed |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3765 "wh\\(ile\\|en\\)\\|xor" ; "when" added |
10705 | 3766 "\\)\\>") |
3767 ;; | |
3768 ;; Anything following end and not already fontified is a body name. | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3769 '("\\<\\(end\\)\\>\\([ \t]+\\)?\\([a-zA-Z0-9_\\.]+\\)?" |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3770 (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) |
10705 | 3771 ;; |
3772 ;; Variable name plus optional keywords followed by a type name. Slow. | |
3773 ; (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:?[ \t]*" | |
3774 ; "\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*" | |
3775 ; "\\(\\sw+\\)?") | |
3776 ; '(1 font-lock-variable-name-face) | |
3777 ; '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t)) | |
3778 ;; | |
3779 ;; Optional keywords followed by a type name. | |
3780 (list (concat ; ":[ \t]*" | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3781 "\\<\\(access\\|constant\\|in[ \t]+out\\|in\\|out\\)\\>" |
10705 | 3782 "[ \t]*" |
3783 "\\(\\sw+\\)?") | |
3784 '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t)) | |
3785 ;; | |
3786 ;; Keywords followed by a type or function name. | |
3787 (list (concat "\\<\\(" | |
3788 "new\\|of\\|subtype\\|type" | |
3789 "\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*\\((\\)?") | |
3790 '(1 font-lock-keyword-face) | |
3791 '(2 (if (match-beginning 4) | |
3792 font-lock-function-name-face | |
3793 font-lock-type-face) nil t)) | |
3794 ;; | |
3795 ;; Keywords followed by a (comma separated list of) reference. | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3796 (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)\\>" ; "when" removed |
10705 | 3797 ; "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?") ; RE |
3798 "[ \t]*\\([a-zA-Z0-9_\\.\\|, ]+\\)\\W") | |
3799 '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t)) | |
3800 ;; | |
3801 ;; Goto tags. | |
3802 '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face) | |
3803 )) | |
13231
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3804 "Gaudy level highlighting for Ada mode.") |
fb78cec8e440
All doc strings changed to comply with standard Emacs conventions.
Richard M. Stallman <rms@gnu.org>
parents:
13160
diff
changeset
|
3805 |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3806 (defvar ada-font-lock-keywords ada-font-lock-keywords-1 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3807 "Default expressions to highlight in Ada mode.") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3808 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3809 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3810 ;; set font-lock properties for XEmacs |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3811 (if (ada-xemacs) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3812 (put 'ada-mode 'font-lock-defaults |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3813 '(ada-font-lock-keywords |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3814 nil t ((?\_ . "w")(?\. . "w")) beginning-of-line))) |
10705 | 3815 |
3816 ;;; | |
17914
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3817 ;;; support for outline |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3818 ;;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3819 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3820 ;; used by outline-minor-mode |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3821 (defun ada-outline-level () |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3822 (save-excursion |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3823 (skip-chars-forward "\t ") |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3824 (current-column))) |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3825 |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3826 ;;; |
e5e2ef0dd5ab
(ada-krunch-args): Use gnatkr instead of gnatk8.
Richard M. Stallman <rms@gnu.org>
parents:
14415
diff
changeset
|
3827 ;;; generate body |
10705 | 3828 ;;; |
3829 (defun ada-gen-comment-until-proc () | |
3830 ;; comment until spec of a procedure or a function. | |
3831 (forward-line 1) | |
3832 (set-mark-command (point)) | |
3833 (if (re-search-forward ada-procedure-start-regexp nil t) | |
3834 (progn (goto-char (match-beginning 1)) | |
3835 (comment-region (mark) (point))) | |
3836 (error "No more functions/procedures"))) | |
3837 | |
3838 | |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3839 (defun ada-gen-treat-proc (match) |
10705 | 3840 ;; make dummy body of a procedure/function specification. |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3841 ;; MATCH is a cons cell containing the start and end location of the |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3842 ;; last search for ada-procedure-start-regexp. |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3843 (goto-char (car match)) |
13160
1b2a4a45f089
(ada-gen-treat-proc): Bind `procname' and `functype'.
Erik Naggum <erik@naggum.no>
parents:
12702
diff
changeset
|
3844 (let (proc-found func-found procname functype) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3845 (cond |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3846 ((or (setq proc-found (looking-at "^[ \t]*procedure")) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3847 (setq func-found (looking-at "^[ \t]*function"))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3848 ;; treat it as a proc/func |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3849 (forward-word 2) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3850 (forward-word -1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3851 (setq procname (buffer-substring (point) (cdr match))) ; store proc name |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3852 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3853 ;; goto end of procname |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3854 (goto-char (cdr match)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3855 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3856 ;; skip over parameterlist |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3857 (forward-sexp) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3858 ;; if function, skip over 'return' and result type. |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3859 (if func-found |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3860 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3861 (forward-word 1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3862 (skip-chars-forward " \t\n") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3863 (setq functype (buffer-substring (point) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3864 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3865 (skip-chars-forward |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3866 "a-zA-Z0-9_\.") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3867 (point)))))) |
10705 | 3868 ;; look for next non WS |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3869 (cond |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3870 ((looking-at "[ \t]*;") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3871 (delete-region (match-beginning 0) (match-end 0)) ;; delete the ';' |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3872 (ada-indent-newline-indent) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3873 (insert " is") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3874 (ada-indent-newline-indent) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3875 (if func-found |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3876 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3877 (insert "Result : ") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3878 (insert functype) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3879 (insert ";") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3880 (ada-indent-newline-indent))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3881 (insert "begin -- ") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3882 (insert procname) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3883 (ada-indent-newline-indent) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3884 (insert "null;") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3885 (ada-indent-newline-indent) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3886 (if func-found |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3887 (progn |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3888 (insert "return Result;") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3889 (ada-indent-newline-indent))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3890 (insert "end ") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3891 (insert procname) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3892 (insert ";") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3893 (ada-indent-newline-indent) |
10705 | 3894 ) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3895 ;; else |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3896 ((looking-at "[ \t\n]*is") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3897 ;; do nothing |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3898 ) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3899 ((looking-at "[ \t\n]*rename") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3900 ;; do nothing |
10705 | 3901 ) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3902 (t |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3903 (message "unknown syntax"))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3904 )))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3905 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3906 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3907 (defun ada-make-body () |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3908 "Create an Ada package body in the current buffer. |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3909 The potential old buffer contents is deleted first, then we copy the |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3910 spec buffer in here and modify it to make it a body. |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3911 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3912 This function typically is to be hooked into `ff-file-created-hooks'." |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3913 (interactive) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3914 (delete-region (point-min) (point-max)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3915 (insert-buffer (car (cdr (buffer-list)))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3916 (ada-mode) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3917 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3918 (let (found) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3919 (if (setq found |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3920 (ada-search-ignore-string-comment ada-package-start-regexp)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3921 (progn (goto-char (cdr found)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3922 (insert " body") |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3923 ;; (forward-line -1) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3924 ;;(comment-region (point-min) (point)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3925 ) |
10705 | 3926 (error "No package")) |
12039
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3927 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3928 ;; (comment-until-proc) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3929 ;; does not work correctly |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3930 ;; must be done by hand |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3931 |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3932 (while (setq found |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3933 (ada-search-ignore-string-comment ada-procedure-start-regexp)) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3934 (ada-gen-treat-proc found)))) |
a75524689022
(initial comments): Copyright 1995; don't speak
Karl Heuer <kwzh@gnu.org>
parents:
11869
diff
changeset
|
3935 |
10705 | 3936 |
3937 ;;; provide ourself | |
3938 | |
3939 (provide 'ada-mode) | |
3940 | |
10707 | 3941 ;;; ada-mode.el ends here |