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