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