aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGerd Moellmann1999-10-28 11:00:34 +0000
committerGerd Moellmann1999-10-28 11:00:34 +0000
commit655880d250fed4339ea4320c66e32828e493d0ee (patch)
tree2fc99e0f163338ec4391081ba73a66481f3f18eb
parent400c12fd9831fa06739ecd3e24b68d051d9c138c (diff)
downloademacs-655880d250fed4339ea4320c66e32828e493d0ee.tar.gz
emacs-655880d250fed4339ea4320c66e32828e493d0ee.zip
Changed format of years in copyright notice.
-rw-r--r--lisp/progmodes/ada-mode.el1153
1 files changed, 539 insertions, 614 deletions
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 3b89e998d52..32043a1b3bb 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,6 +1,6 @@
1;; @(#) ada-mode.el --- major-mode for editing Ada source. 1;; @(#) ada-mode.el --- major-mode for editing Ada sources.
2 2
3;; Copyright (C) 1994-1999 Free Software Foundation, Inc. 3;; Copyright (C) 1994, 1995, 1997, 1998, 1999 Free Software Foundation, Inc.
4 4
5;; Author: Rolf Ebert <ebert@inf.enst.fr> 5;; Author: Rolf Ebert <ebert@inf.enst.fr>
6;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> 6;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
@@ -27,10 +27,10 @@
27 27
28;;; Commentary: 28;;; Commentary:
29;;; This mode is a major mode for editing Ada83 and Ada95 source code. 29;;; This mode is a major mode for editing Ada83 and Ada95 source code.
30;;; This is a major rewrite of the file packaged with Emacs-20. The 30;;; This is a major rewrite of the file packaged with Emacs-20.2. The
31;;; ada-mode is composed of four lisp file, ada-mode.el, ada-xref.el, 31;;; ada-mode is composed of four lisp file, ada-mode.el, ada-xref.el,
32;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is 32;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is
33;;; completly independant from the GNU Ada compiler Gnat, distributed 33;;; completely independent from the GNU Ada compiler Gnat, distributed
34;;; by Ada Core Technologies. All the other files rely heavily on 34;;; by Ada Core Technologies. All the other files rely heavily on
35;;; features provides only by Gnat. 35;;; features provides only by Gnat.
36;;; 36;;;
@@ -97,20 +97,20 @@
97;;; Code: 97;;; Code:
98;;; Note: Every function is this package is compiler-independent. 98;;; Note: Every function is this package is compiler-independent.
99;;; The names start with ada- 99;;; The names start with ada-
100;;; The variables that the user can edit can all be modified throught 100;;; The variables that the user can edit can all be modified through
101;;; the customize mode. They are sorted in alphabetical order in this 101;;; the customize mode. They are sorted in alphabetical order in this
102;;; file. 102;;; file.
103 103
104 104
105;; this function is needed at compile time 105;; this function is needed at compile time
106(eval-and-compile 106(eval-and-compile
107 (defun ada-check-emacs-version (major minor &optional is_xemacs) 107 (defun ada-check-emacs-version (major minor &optional is-xemacs)
108 "Returns t if Emacs's version is greater or equal to major.minor. 108 "Returns t if Emacs's version is greater or equal to MAJOR.MINOR.
109if IS_XEMACS is non-nil, check for XEmacs instead of Emacs" 109If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
110 (let ((xemacs_running (or (string-match "Lucid" emacs-version) 110 (let ((xemacs-running (or (string-match "Lucid" emacs-version)
111 (string-match "XEmacs" emacs-version)))) 111 (string-match "XEmacs" emacs-version))))
112 (and (or (and is_xemacs xemacs_running) 112 (and (or (and is-xemacs xemacs-running)
113 (not (or is_xemacs xemacs_running))) 113 (not (or is-xemacs xemacs-running)))
114 (or (> emacs-major-version major) 114 (or (> emacs-major-version major)
115 (and (= emacs-major-version major) 115 (and (= emacs-major-version major)
116 (>= emacs-minor-version minor))))))) 116 (>= emacs-minor-version minor)))))))
@@ -119,7 +119,7 @@ if IS_XEMACS is non-nil, check for XEmacs instead of Emacs"
119;; We create a constant for that, for efficiency only 119;; We create a constant for that, for efficiency only
120;; This should not be evaluated at compile time, only a runtime 120;; This should not be evaluated at compile time, only a runtime
121(defconst ada-xemacs (boundp 'running-xemacs) 121(defconst ada-xemacs (boundp 'running-xemacs)
122 "Return t if we are using XEmacs") 122 "Return t if we are using XEmacs.")
123 123
124(unless ada-xemacs 124(unless ada-xemacs
125 (require 'outline)) 125 (require 'outline))
@@ -129,7 +129,7 @@ if IS_XEMACS is non-nil, check for XEmacs instead of Emacs"
129 129
130;; This call should not be made in the release that is done for the 130;; This call should not be made in the release that is done for the
131;; official FSF Emacs, since it does nothing useful for the latest version 131;; official FSF Emacs, since it does nothing useful for the latest version
132(require 'ada-support) 132;; (require 'ada-support)
133 133
134(defvar ada-mode-hook nil 134(defvar ada-mode-hook nil
135 "*List of functions to call when Ada mode is invoked. 135 "*List of functions to call when Ada mode is invoked.
@@ -138,7 +138,7 @@ fully loaded.
138This is a good place to add Ada environment specific bindings.") 138This is a good place to add Ada environment specific bindings.")
139 139
140(defgroup ada nil 140(defgroup ada nil
141 "Major mode for editing Ada source in Emacs" 141 "Major mode for editing Ada source in Emacs."
142 :group 'languages) 142 :group 'languages)
143 143
144(defcustom ada-auto-case t 144(defcustom ada-auto-case t
@@ -175,14 +175,13 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
175 :group 'ada) 175 :group 'ada)
176 176
177(defcustom ada-case-exception-file "~/.emacs_case_exceptions" 177(defcustom ada-case-exception-file "~/.emacs_case_exceptions"
178 "*Name of the file that contains the list of special casing 178 "*File name for the dictionary of special casing exceptions for identifiers.
179exceptions for identifiers.
180This file should contain one word per line, that gives the casing 179This file should contain one word per line, that gives the casing
181to be used for that words in Ada files" 180to be used for that words in Ada files."
182 :type 'file :group 'ada) 181 :type 'file :group 'ada)
183 182
184(defcustom ada-case-keyword 'downcase-word 183(defcustom ada-case-keyword 'downcase-word
185 "*Function to call to adjust the case of Ada keywords. 184 "*Function to call to adjust the case of an Ada keywords.
186It may be `downcase-word', `upcase-word', `ada-loose-case-word' or 185It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
187`ada-capitalize-word'." 186`ada-capitalize-word'."
188 :type '(choice (const downcase-word) 187 :type '(choice (const downcase-word)
@@ -202,7 +201,7 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
202 :group 'ada) 201 :group 'ada)
203 202
204(defcustom ada-clean-buffer-before-saving t 203(defcustom ada-clean-buffer-before-saving t
205 "*Non-nil means `remove-trailing-spaces' and `untabify' buffer before saving." 204 "*Non-nil means remove trailing spaces and untabify the buffer before saving."
206 :type 'boolean :group 'ada) 205 :type 'boolean :group 'ada)
207 206
208(defcustom ada-indent 3 207(defcustom ada-indent 3
@@ -219,7 +218,7 @@ begin
219 :type 'boolean :group 'ada) 218 :type 'boolean :group 'ada)
220 219
221(defcustom ada-indent-comment-as-code t 220(defcustom ada-indent-comment-as-code t
222 "*Non-nil means indent comment lines as code" 221 "*Non-nil means indent comment lines as code."
223 :type 'boolean :group 'ada) 222 :type 'boolean :group 'ada)
224 223
225(defcustom ada-indent-is-separate t 224(defcustom ada-indent-is-separate t
@@ -237,7 +236,7 @@ An example is:
237(defcustom ada-indent-return 0 236(defcustom ada-indent-return 0
238 "*Indentation for 'return' relative to the matching 'function' statement. 237 "*Indentation for 'return' relative to the matching 'function' statement.
239If ada-indent-return is null or negative, the indentation is done relative to 238If ada-indent-return is null or negative, the indentation is done relative to
240the open parenthesis (if there is no parenthesis, ada-broken-indent is used) 239the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
241 240
242An example is: 241An example is:
243 function A (B : Integer) 242 function A (B : Integer)
@@ -273,27 +272,29 @@ begin
273 :type '(choice (const ada83) (const ada95)) :group 'ada) 272 :type '(choice (const ada83) (const ada95)) :group 'ada)
274 273
275(defcustom ada-move-to-declaration nil 274(defcustom ada-move-to-declaration nil
276 "*Non-nil means `ada-move-to-start' moves point to the subprog declaration, 275 "*Non-nil means `ada-move-to-start' moves point to the subprogram declaration,
277not to 'begin'." 276not to 'begin'."
278 :type 'boolean :group 'ada) 277 :type 'boolean :group 'ada)
279 278
280(defcustom ada-popup-key '[down-mouse-3] 279(defcustom ada-popup-key '[down-mouse-3]
281 "*Key used for binding the contextual menu. 280 "*Key used for binding the contextual menu.
282if nil, no contextual menu is available") 281If nil, no contextual menu is available.")
283 282
284(defcustom ada-search-directories 283(defcustom ada-search-directories
285 '("." "$ADA_INCLUDE_PATH" "/usr/adainclude" "/usr/local/adainclude" 284 '("." "$ADA_INCLUDE_PATH" "/usr/adainclude" "/usr/local/adainclude"
286 "/opt/gnu/adainclude") 285 "/opt/gnu/adainclude")
287 "*List of directories to search for Ada files. See the description 286 "*List of directories to search for Ada files.
288for the `ff-search-directories' variable. 287See the description for the `ff-search-directories' variable.
289Emacs will automatically add the paths defined in your project file." 288Emacs will automatically add the paths defined in your project file, and if you
289are using the GNAT compiler the output of the gnatls command to find where the
290runtime really is."
290 :type '(repeat (choice :tag "Directory" 291 :type '(repeat (choice :tag "Directory"
291 (const :tag "default" nil) 292 (const :tag "default" nil)
292 (directory :format "%v"))) 293 (directory :format "%v")))
293 :group 'ada) 294 :group 'ada)
294 295
295(defcustom ada-stmt-end-indent 0 296(defcustom ada-stmt-end-indent 0
296 "*Number of columns to indent a statement end keyword on a separate line. 297 "*Number of columns to indent the end of a statement on a separate line.
297 298
298An example is: 299An example is:
299 if A = B 300 if A = B
@@ -301,8 +302,7 @@ An example is:
301 :type 'integer :group 'ada) 302 :type 'integer :group 'ada)
302 303
303(defcustom ada-tab-policy 'indent-auto 304(defcustom ada-tab-policy 'indent-auto
304 "*Control the behaviour of the TAB key. 305 "*Control the behavior of the TAB key.
305This is used only in the ada-tab and ada-untab functions.
306Must be one of : 306Must be one of :
307`indent-rigidly' : always adds ada-indent blanks at the beginning of the line. 307`indent-rigidly' : always adds ada-indent blanks at the beginning of the line.
308`indent-auto' : use indentation functions in this file. 308`indent-auto' : use indentation functions in this file.
@@ -317,13 +317,13 @@ Must be one of :
317 317
318An example is: 318An example is:
319 case A is 319 case A is
320 >>>>>>>>when B => -- from ada-when-indentx" 320 >>>>>>>>when B => -- from ada-when-indent"
321 :type 'integer :group 'ada) 321 :type 'integer :group 'ada)
322 322
323(defcustom ada-which-compiler 'gnat 323(defcustom ada-which-compiler 'gnat
324 "*Name of the compiler we use. This will determine what features are 324 "*Name of the compiler to use.
325made available through the ada-mode. The possible choices are : 325This will determine what features are made available through the ada-mode.
326 326The possible choices are :
327`gnat': Use Ada Core Technologies' Gnat compiler. Add some cross-referencing 327`gnat': Use Ada Core Technologies' Gnat compiler. Add some cross-referencing
328 features 328 features
329`generic': Use a generic compiler" 329`generic': Use a generic compiler"
@@ -336,15 +336,15 @@ made available through the ada-mode. The possible choices are :
336 336
337 337
338(defvar ada-body-suffixes '(".adb") 338(defvar ada-body-suffixes '(".adb")
339 "List of possible suffixes for Ada body files. The extensions should 339 "List of possible suffixes for Ada body files.
340include a `.' if needed") 340The extensions should include a `.' if needed.")
341 341
342(defvar ada-spec-suffixes '(".ads") 342(defvar ada-spec-suffixes '(".ads")
343 "List of possible suffixes for Ada spec files. The extensions should 343 "List of possible suffixes for Ada spec files.
344include a `.' if needed") 344The extensions should include a `.' if needed.")
345 345
346(defvar ada-mode-menu (make-sparse-keymap) 346(defvar ada-mode-menu (make-sparse-keymap)
347 "Menu for ada-mode") 347 "Menu for ada-mode.")
348 348
349(defvar ada-mode-map (make-sparse-keymap) 349(defvar ada-mode-map (make-sparse-keymap)
350 "Local keymap used for Ada mode.") 350 "Local keymap used for Ada mode.")
@@ -365,24 +365,21 @@ include a `.' if needed")
365 "procedure" "raise" "range" "record" "rem" "renames" "return" 365 "procedure" "raise" "range" "record" "rem" "renames" "return"
366 "reverse" "select" "separate" "subtype" "task" "terminate" "then" 366 "reverse" "select" "separate" "subtype" "task" "terminate" "then"
367 "type" "use" "when" "while" "with" "xor") 367 "type" "use" "when" "while" "with" "xor")
368 "List of ada keywords -- This variable is not used instead to define 368 "List of Ada keywords.
369ada-83-keywords and ada-95-keywords")) 369This variable is used to define `ada-83-keywords' and `ada-95-keywords'"))
370 370
371(defvar ada-ret-binding nil 371(defvar ada-ret-binding nil
372 "Variable to save key binding of RET when casing is activated.") 372 "Variable to save key binding of RET when casing is activated.")
373 373
374(defvar ada-case-exception '() 374(defvar ada-case-exception '()
375 "Alist of words (entities) that have special casing, and should not 375 "Alist of words (entities) that have special casing.")
376be reindented according to the function `ada-case-identifier'.
377Its value is read from the file `ada-case-exception-file'")
378 376
379(defvar ada-lfd-binding nil 377(defvar ada-lfd-binding nil
380 "Variable to save key binding of LFD when casing is activated.") 378 "Variable to save key binding of LFD when casing is activated.")
381 379
382(defvar ada-other-file-alist nil 380(defvar ada-other-file-alist nil
383 "Variable used by find-file to find the name of the other package. 381 "Variable used by find-file to find the name of the other package.
384See `ff-other-file-alist'" 382See `ff-other-file-alist'.")
385 )
386 383
387;;; ---- Below are the regexp used in this package for parsing 384;;; ---- Below are the regexp used in this package for parsing
388 385
@@ -413,7 +410,7 @@ See `ff-other-file-alist'"
413 410
414(defvar ada-package-start-regexp 411(defvar ada-package-start-regexp
415 "^[ \t]*\\(package\\)" 412 "^[ \t]*\\(package\\)"
416 "Regexp used to find Ada packages") 413 "Regexp used to find Ada packages.")
417 414
418 415
419;;; ---- regexps for indentation functions 416;;; ---- regexps for indentation functions
@@ -448,7 +445,7 @@ A new statement starts after these.")
448 '("end" "loop" "select" "begin" "case" "do" 445 '("end" "loop" "select" "begin" "case" "do"
449 "if" "task" "package" "record" "protected") t) 446 "if" "task" "package" "record" "protected") t)
450 "\\>")) 447 "\\>"))
451 "Regexp used in ada-goto-matching-start") 448 "Regexp used in ada-goto-matching-start.")
452 449
453(defvar ada-matching-decl-start-re 450(defvar ada-matching-decl-start-re
454 (eval-when-compile 451 (eval-when-compile
@@ -456,7 +453,7 @@ A new statement starts after these.")
456 (regexp-opt 453 (regexp-opt
457 '("is" "separate" "end" "declare" "if" "new" "begin" "generic") t) 454 '("is" "separate" "end" "declare" "if" "new" "begin" "generic") t)
458 "\\>")) 455 "\\>"))
459 "Regexp used in ada-goto-matching-decl-start") 456 "Regexp used in ada-goto-matching-decl-start.")
460 457
461 458
462(defvar ada-loop-start-re 459(defvar ada-loop-start-re
@@ -473,6 +470,46 @@ A new statement starts after these.")
473 "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]" 470 "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
474 "Regexp of the name of a block or loop.") 471 "Regexp of the name of a block or loop.")
475 472
473(defvar ada-contextual-menu-on-identifier nil
474 "Set to true when the right mouse button was clicked on an identifier.")
475
476(defvar ada-contextual-menu
477 "Defines the menu to use when the user presses the right mouse button.
478The variable `ada-contextual-menu-on-identifier' will be set to t before
479displaying the menu if point was on an identifier."
480 (if ada-xemacs
481 '("Ada"
482 ["Goto Declaration/Body" ada-goto-declaration
483 :included ada-contextual-menu-on-identifier]
484 ["Goto Previous Reference" ada-xref-goto-previous-reference]
485 ["List References" ada-find-references
486 :included ada-contextual-menu-on-identifier]
487 ["-" nil nil]
488 ["Other File" ff-find-other-file]
489 ["Goto Parent Unit" ada-goto-parent]
490 )
491
492 (let ((map (make-sparse-keymap "Ada")))
493 ;; The identifier part
494 (if (equal ada-which-compiler 'gnat)
495 (progn
496 (define-key-after map [Ref]
497 '(menu-item "Goto Declaration/Body"
498 ada-point-and-xref
499 :visible ada-contextual-menu-on-identifier
500 ) t)
501 (define-key-after map [Prev]
502 '("Goto Previous Reference" .ada-xref-goto-previous-reference) t)
503 (define-key-after map [List]
504 '(menu-item "List References"
505 ada-find-references
506 :visible ada-contextual-menu-on-identifier) t)
507 (define-key-after map [-] '("-" nil) t)
508 ))
509 (define-key-after map [Other] '("Other file" . ff-find-other-file) t)
510 (define-key-after map [Parent] '("Goto Parent Unit" . ada-goto-parent)t)
511 map)))
512
476 513
477 514
478;;------------------------------------------------------------------ 515;;------------------------------------------------------------------
@@ -492,31 +529,30 @@ A new statement starts after these.")
492 '("*Tasks*" "^[ \t]*task[ \t]+\\(\\(body\\|type\\)[ \t]+\\)?\\(\\(\\sw\\|_\\)+\\)" 3) 529 '("*Tasks*" "^[ \t]*task[ \t]+\\(\\(body\\|type\\)[ \t]+\\)?\\(\\(\\sw\\|_\\)+\\)" 3)
493 '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2) 530 '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
494 '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1)) 531 '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1))
495 "Imenu generic expression for Ada mode. See `imenu-generic-expression'. 532 "Imenu generic expression for Ada mode.
496This variable will create two submenus, one for type and subtype definitions, 533See `imenu-generic-expression'. This variable will create two submenus, one
497the other for subprograms declarations. The main menu will reference the bodies 534for type and subtype definitions, the other for subprograms declarations.
498of the subprograms.") 535The main menu will reference the bodies of the subprograms.")
499 536
500 537
501
502;;------------------------------------------------------------ 538;;------------------------------------------------------------
503;; Supporte for compile.el 539;; Support for compile.el
504;;------------------------------------------------------------ 540;;------------------------------------------------------------
505 541
506(defun ada-compile-mouse-goto-error () 542(defun ada-compile-mouse-goto-error ()
507 "mouse interface for ada-compile-goto-error" 543 "Mouse interface for `ada-compile-goto-error'."
508 (interactive) 544 (interactive)
509 (mouse-set-point last-input-event) 545 (mouse-set-point last-input-event)
510 (ada-compile-goto-error (point)) 546 (ada-compile-goto-error (point))
511 ) 547 )
512 548
513(defun ada-compile-goto-error (pos) 549(defun ada-compile-goto-error (pos)
514 "replaces compile-goto-error from compile.el: if point is on an file and line 550 "Replaces `compile-goto-error' from compile.el.
515location, go to this position. It adds to compile.el the capacity to go to a 551If POS is on a file and line location, go to this position. It adds to
516reference in an error message. 552compile.el the capacity to go to a reference in an error message.
517For instance, on this line: 553For instance, on this line:
518 foo.adb:61:11: missing argument for parameter set in call to size declared at foo.ads:11 554 foo.adb:61:11: [...] in call to size declared at foo.ads:11
519both file locations can be clicked on and jumped to" 555both file locations can be clicked on and jumped to."
520 (interactive "d") 556 (interactive "d")
521 (goto-char pos) 557 (goto-char pos)
522 558
@@ -546,16 +582,40 @@ both file locations can be clicked on and jumped to"
546 ) 582 )
547 (recenter)) 583 (recenter))
548 584
549;;;------------- 585;;-------------------------------------------------------------------------
550;;; functions 586;; Grammar related function
551;;;------------- 587;; The functions below work with the syntax class of the characters in an Ada
588;; buffer. Two syntax tables are created, depending on whether we want '_'
589;; to be considered as part of a word or not.
590;; Some characters may have multiple meanings depending on the context:
591;; - ' is either the beginning of a constant character or an attribute
592;; - # is either part of a based litteral or a gnatprep statement.
593;; - " starts a string, but not if inside a constant character.
594;; - ( and ) should be ignored if inside a constant character.
595;; Thus their syntax property is changed automatically, and we can still use
596;; the standard Emacs functions for sexp (see `ada-in-string-p')
597;;
598;; On Emacs, this is done through the `syntax-table' text property. The
599;; modification is done automatically each time the user as typed a new
600;; character. This is already done in `font-lock-mode' (in
601;; `font-lock-syntactic-keywords', so we take advantage of the existing
602;; mechanism. If font-lock-mode is not activated, we do it by hand in
603;; `ada-after-change-function', thanks to `ada-deactivate-properties' and
604;; `ada-initialize-properties'.
605;;
606;; on XEmacs, the `syntax-table' property does not exist and we have to use a
607;; slow advice to `parse-partial-sexp' to do the same thing.
608;; When executing parse-partial-sexp, we simply modify the strings before and
609;; after, so that the special constants '"', '(' and ')' do not interact
610;; with parse-partial-sexp.
611;; Note: this code is slow and needs to be rewritten as soon as something
612;; better is available on XEmacs.
613;;-------------------------------------------------------------------------
552 614
553(defun ada-create-syntax-table () 615(defun ada-create-syntax-table ()
554 "Create the syntax table for Ada mode." 616 "Create the two syntax tables use in the Ada mode.
555 ;; There are two different syntax-tables. The standard one declares 617The standard table declares `_' as a symbol constituent, the second one
556 ;; `_' as a symbol constituant, in the second one, it is a word 618declares it as a word constituent."
557 ;; constituant. For some search and replacing routines we
558 ;; temporarily switch between the two.
559 (interactive) 619 (interactive)
560 (set 'ada-mode-syntax-table (make-syntax-table)) 620 (set 'ada-mode-syntax-table (make-syntax-table))
561 (set-syntax-table ada-mode-syntax-table) 621 (set-syntax-table ada-mode-syntax-table)
@@ -588,13 +648,8 @@ both file locations can be clicked on and jumped to"
588 ;; a single hyphen is punctuation, but a double hyphen starts a comment 648 ;; a single hyphen is punctuation, but a double hyphen starts a comment
589 (modify-syntax-entry ?- ". 12" ada-mode-syntax-table) 649 (modify-syntax-entry ?- ". 12" ada-mode-syntax-table)
590 650
591 ;; # is set to be a matched-pair, since it is used for based numbers, 651 ;; See the comment above on grammar related function for the special
592 ;; as in 16#3f#. The syntax class will be modifed later when it 652 ;; setup for '#'.
593 ;; appears at the beginning of a line for gnatprep statements.
594 ;; For Emacs, the modification is done in font-lock-syntactic-keywords
595 ;; or ada-after-change-function.
596 ;; For XEmacs, this is not done correctly for now, based numbers won't
597 ;; be handled correctly.
598 (if ada-xemacs 653 (if ada-xemacs
599 (modify-syntax-entry ?# "<" ada-mode-syntax-table) 654 (modify-syntax-entry ?# "<" ada-mode-syntax-table)
600 (modify-syntax-entry ?# "$" ada-mode-syntax-table)) 655 (modify-syntax-entry ?# "$" ada-mode-syntax-table))
@@ -614,15 +669,12 @@ both file locations can be clicked on and jumped to"
614 (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table) 669 (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
615 ) 670 )
616 671
617;; 672;; Support of special characters in XEmacs (see the comments at the beginning
618;; This is to support XEmacs, which does not have the syntax-table attribute 673;; of the section on Grammar related functions).
619;; as used in ada-after-change-function
620;; When executing parse-partial-sexp, we simply modify the strings before and
621;; after, so that the special constants '"', '(' and ')' do not interact
622;; with parse-partial-sexp.
623 674
624(if ada-xemacs 675(if ada-xemacs
625 (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants) 676 (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
677 "Handles special character constants and gnatprep statements."
626 (let (change) 678 (let (change)
627 (if (< to from) 679 (if (< to from)
628 (let ((tmp from)) 680 (let ((tmp from))
@@ -650,33 +702,15 @@ both file locations can be clicked on and jumped to"
650 (insert (caddar change)) 702 (insert (caddar change))
651 (set 'change (cdr change))))))) 703 (set 'change (cdr change)))))))
652 704
653;;
654;; The following three functions handle the text properties in the buffer:
655;; the problem in Ada is that ' can be both a constant character delimiter
656;; and an attribute delimiter. To handle this easily (and allowing us to
657;; use the standard Emacs functions for sexp... as in ada-in-string-p), we
658;; change locally the syntax table every time we see a character constant.
659;; The three characters are then said to be part of a string.
660;; This handles nicely the '"' case (" is simply ignored in that case)
661;;
662;; The idea for this code was borrowed from font-lock.el, which actually
663;; does the same job thanks to ada-font-lock-syntactic-keywords. No need
664;; to duplicate the work if we already use font-lock
665;;
666;; This code is not executed for XEmacs, since the syntax-table attribute is
667;; not known
668
669(defun ada-deactivate-properties () 705(defun ada-deactivate-properties ()
670 "Deactivate ada-mode's properties handling, since this would be 706 "Deactivate ada-mode's properties handling.
671a duplicate of font-lock" 707This would be a duplicate of font-lock if both are used at the same time."
672 (remove-hook 'after-change-functions 'ada-after-change-function t)) 708 (remove-hook 'after-change-functions 'ada-after-change-function t))
673 709
674(defun ada-initialize-properties () 710(defun ada-initialize-properties ()
675 "Initialize some special text properties in the whole buffer. 711 "Initialize some special text properties in the whole buffer.
676In particular, character constants that contain string delimiters are said 712In particular, character constants are said to be strings, #...# are treated
677to be strings. 713as numbers instead of gnatprep comments."
678We also treat #..# as numbers, instead of gnatprep comments
679"
680 (save-excursion 714 (save-excursion
681 (save-restriction 715 (save-restriction
682 (widen) 716 (widen)
@@ -698,8 +732,8 @@ We also treat #..# as numbers, instead of gnatprep comments
698 ))) 732 )))
699 733
700(defun ada-after-change-function (beg end old-len) 734(defun ada-after-change-function (beg end old-len)
701 "Called every time a character is changed in the buffer" 735 "Called when the region between BEG and END was changed in the buffer.
702 ;; borrowed from font-lock.el 736OLD-LEN indicates what the length of the replaced text was."
703 (let ((inhibit-point-motion-hooks t) 737 (let ((inhibit-point-motion-hooks t)
704 (eol (point))) 738 (eol (point)))
705 (save-excursion 739 (save-excursion
@@ -716,66 +750,48 @@ We also treat #..# as numbers, instead of gnatprep comments
716 )))) 750 ))))
717 751
718 752
719(defvar ada-contextual-menu-on-identifier nil) 753;;------------------------------------------------------------------
720 754;; Contextual menus
721(defvar ada-contextual-menu 755;; The Ada-mode comes with fully contextual menus, bound by default
722 (if ada-xemacs 756;; on the right mouse button.
723 '("Ada" 757;; Add items to this menu by modifying `ada-contextual-menu'. Note that the
724 ["Goto Declaration/Body" ada-goto-declaration 758;; variable `ada-contextual-menu-on-identifier' is set automatically to t
725 :included ada-contextual-menu-on-identifier] 759;; if the mouse button was pressed on an identifier.
726 ["Goto Previous Reference" ada-xref-goto-previous-reference] 760;;------------------------------------------------------------------
727 ["List References" ada-find-references
728 :included ada-contextual-menu-on-identifier]
729 ["-" nil nil]
730 ["Other File" ff-find-other-file]
731 ["Goto Parent Unit" ada-goto-parent]
732 )
733
734 (let ((map (make-sparse-keymap "Ada")))
735 ;; The identifier part
736 (if (equal ada-which-compiler 'gnat)
737 (progn
738 (define-key-after map [Ref]
739 '(menu-item "Goto Declaration/Body"
740 ada-point-and-xref
741 :visible ada-contextual-menu-on-identifier
742 ) t)
743 (define-key-after map [Prev]
744 '("Goto Previous Reference" .ada-xref-goto-previous-reference) t)
745 (define-key-after map [List]
746 '(menu-item "List References"
747 ada-find-references
748 :visible ada-contextual-menu-on-identifier) t)
749 (define-key-after map [-] '("-" nil) t)
750 ))
751 (define-key-after map [Other] '("Other file" . ff-find-other-file) t)
752 (define-key-after map [Parent] '("Goto Parent Unit" . ada-goto-parent)t)
753 map)))
754 761
755(defun ada-popup-menu (position) 762(defun ada-popup-menu (position)
756 "Pops up a contextual menu, depending on where the user clicked" 763 "Pops up a contextual menu, depending on where the user clicked.
764POSITION is the location the mouse was clicked on."
757 (interactive "e") 765 (interactive "e")
758 (mouse-set-point last-input-event) 766 (save-excursion
767 (mouse-set-point last-input-event)
768
769 (setq ada-contextual-menu-on-identifier
770 (and (char-after)
771 (or (= (char-syntax (char-after)) ?w)
772 (= (char-after) ?_))
773 (not (ada-in-string-or-comment-p))
774 (save-excursion (skip-syntax-forward "w")
775 (not (ada-after-keyword-p)))
776 ))
777 (let (choice)
778 (if ada-xemacs
779 (set 'choice (popup-menu ada-contextual-menu))
780 (set 'choice (x-popup-menu position ada-contextual-menu)))
781 (if choice
782 (funcall (lookup-key ada-contextual-menu (vector (car choice))))))))
759 783
760 (setq ada-contextual-menu-on-identifier 784;;------------------------------------------------------------------
761 (and (or (= (char-syntax (char-after)) ?w) 785;; Misc functions
762 (= (char-after) ?_)) 786;;------------------------------------------------------------------
763 (not (ada-in-string-or-comment-p))
764 (save-excursion (skip-syntax-forward "w")
765 (not (ada-after-keyword-p)))
766 ))
767 (let (choice)
768 (if ada-xemacs
769 (set 'choice (popup-menu ada-contextual-menu))
770 (set 'choice (x-popup-menu position ada-contextual-menu)))
771 (if choice
772 (funcall (lookup-key ada-contextual-menu (vector (car choice)))))))
773 787
774;;;###autoload 788;;;###autoload
775(defun ada-add-extensions (spec body) 789(defun ada-add-extensions (spec body)
776 "Add a new set of extensions to the ones recognized by ada-mode. 790 "Define SPEC and BODY as being valid extensions for Ada files.
777The addition is done so that `goto-other-file' works as expected" 791Going from body to spec with `ff-find-other-file' used these
778 792extensions.
793SPEC and BODY are two regular expressions that must match against the file
794name"
779 (let* ((reg (concat (regexp-quote body) "$")) 795 (let* ((reg (concat (regexp-quote body) "$"))
780 (tmp (assoc reg ada-other-file-alist))) 796 (tmp (assoc reg ada-other-file-alist)))
781 (if tmp 797 (if tmp
@@ -874,7 +890,7 @@ If you use ada-xref.el:
874 ;; used by autofill to break a comment line and continue it on another line. 890 ;; used by autofill to break a comment line and continue it on another line.
875 ;; The reason we need this one is that the default behavior does not work 891 ;; The reason we need this one is that the default behavior does not work
876 ;; correctly with the definition of paragraph-start above when the comment 892 ;; correctly with the definition of paragraph-start above when the comment
877 ;; is right after a multiline subprogram declaration (the comments are 893 ;; is right after a multi-line subprogram declaration (the comments are
878 ;; aligned under the latest parameter, not under the declaration start). 894 ;; aligned under the latest parameter, not under the declaration start).
879 (set (make-local-variable 'comment-line-break-function) 895 (set (make-local-variable 'comment-line-break-function)
880 (lambda (&optional soft) (let ((fill-prefix nil)) 896 (lambda (&optional soft) (let ((fill-prefix nil))
@@ -921,7 +937,7 @@ If you use ada-xref.el:
921 )) 937 ))
922 938
923 ;; font-lock support : 939 ;; font-lock support :
924 ;; We need to set some properties for Xemacs, and define some variables 940 ;; We need to set some properties for XEmacs, and define some variables
925 ;; for Emacs 941 ;; for Emacs
926 942
927 (if ada-xemacs 943 (if ada-xemacs
@@ -1047,18 +1063,24 @@ If you use ada-xref.el:
1047 (ada-activate-keys-for-case))) 1063 (ada-activate-keys-for-case)))
1048 1064
1049 1065
1050 1066;;-----------------------------------------------------------------
1051;;;-------------------------------------------------------- 1067;; auto-casing
1052;;; auto-casing 1068;; Since Ada is case-insensitive, the Ada-mode provides an extensive set of
1053;;;-------------------------------------------------------- 1069;; functions to auto-case identifiers, keywords, ...
1054 1070;; The basic rules for autocasing are defined through the variables
1071;; `ada-case-attribute', `ada-case-keyword' and `ada-case-identifier'. These
1072;; are references to the functions that will do the actual casing.
1073;;
1074;; However, in most cases, the user will want to define some exceptions to
1075;; these casing rules. This is done through a list of files, that contain
1076;; one word per line. These files are stored in `ada-case-exception-file'.
1077;;-----------------------------------------------------------------
1055 1078
1056(defun ada-create-case-exception (&optional word) 1079(defun ada-create-case-exception (&optional word)
1057 "Defines WORD as an exception for the casing system. If WORD 1080 "Defines WORD as an exception for the casing system.
1058is not given, then the current word in the buffer is used instead. 1081If WORD is not given, then the current word in the buffer is used instead.
1059Every time the ada-mode will see the same word, the same casing will 1082The new words is added to the first file in `ada-case-exception-file'.
1060be used. 1083The standard casing rules will no longer apply to this word."
1061The new words is added to the file `ada-case-exception-file'"
1062 (interactive) 1084 (interactive)
1063 (let ((previous-syntax-table (syntax-table)) 1085 (let ((previous-syntax-table (syntax-table))
1064 (exception-list '())) 1086 (exception-list '()))
@@ -1118,8 +1140,7 @@ The new words is added to the file `ada-case-exception-file'"
1118 )) 1140 ))
1119 1141
1120(defun ada-case-read-exceptions () 1142(defun ada-case-read-exceptions ()
1121 "Read the file `ada-case-exception-file' for the list of identifiers that 1143 "Parse `ada-case-exception-file' for the dictionary of casing exceptions."
1122have special casing"
1123 (interactive) 1144 (interactive)
1124 (set 'ada-case-exception '()) 1145 (set 'ada-case-exception '())
1125 (if (file-readable-p (expand-file-name ada-case-exception-file)) 1146 (if (file-readable-p (expand-file-name ada-case-exception-file))
@@ -1140,10 +1161,9 @@ have special casing"
1140 ))) 1161 )))
1141 1162
1142(defun ada-adjust-case-identifier () 1163(defun ada-adjust-case-identifier ()
1143 "Adjust case of the previous identifier. The auto-casing is 1164 "Adjust case of the previous identifier.
1144done according to the value of `ada-case-identifier' and the 1165The auto-casing is done according to the value of `ada-case-identifier' and
1145exceptions defined in `ada-case-exception'" 1166the exceptions defined in `ada-case-exception-file'."
1146
1147 (if (or (equal ada-case-exception '()) 1167 (if (or (equal ada-case-exception '())
1148 (equal (char-after) ?_)) 1168 (equal (char-after) ?_))
1149 (funcall ada-case-identifier -1) 1169 (funcall ada-case-identifier -1)
@@ -1161,11 +1181,11 @@ exceptions defined in `ada-case-exception'"
1161 (delete-region start end) 1181 (delete-region start end)
1162 (insert (car match))) 1182 (insert (car match)))
1163 1183
1164 ;; Else simply recase the word 1184 ;; Else simply re-case the word
1165 (funcall ada-case-identifier -1)))))) 1185 (funcall ada-case-identifier -1))))))
1166 1186
1167(defun ada-after-keyword-p () 1187(defun ada-after-keyword-p ()
1168 ;; returns t if cursor is after a keyword. 1188 "Returns t if cursor is after a keyword."
1169 (save-excursion 1189 (save-excursion
1170 (forward-word -1) 1190 (forward-word -1)
1171 (and (not (and (char-before) (= (char-before) ?_)));; unless we have a _ 1191 (and (not (and (char-before) (= (char-before) ?_)));; unless we have a _
@@ -1173,9 +1193,7 @@ exceptions defined in `ada-case-exception'"
1173 1193
1174(defun ada-adjust-case (&optional force-identifier) 1194(defun ada-adjust-case (&optional force-identifier)
1175 "Adjust the case of the word before the just typed character. 1195 "Adjust the case of the word before the just typed character.
1176Respect options `ada-case-keyword', `ada-case-identifier', and 1196If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier."
1177`ada-case-attribute'.
1178If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH)
1179 (let ((previous-syntax-table (syntax-table))) 1197 (let ((previous-syntax-table (syntax-table)))
1180 (set-syntax-table ada-mode-symbol-syntax-table) 1198 (set-syntax-table ada-mode-symbol-syntax-table)
1181 1199
@@ -1212,6 +1230,8 @@ If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH)
1212 ) 1230 )
1213 1231
1214(defun ada-adjust-case-interactive (arg) 1232(defun ada-adjust-case-interactive (arg)
1233 "Adjust the case of the previous word, and process the character just typed.
1234ARG is the prefix the user entered with \C-u."
1215 (interactive "P") 1235 (interactive "P")
1216 (let ((lastk last-command-char)) 1236 (let ((lastk last-command-char))
1217 (cond ((or (eq lastk ?\n) 1237 (cond ((or (eq lastk ?\n)
@@ -1219,7 +1239,7 @@ If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH)
1219 ;; horrible kludge 1239 ;; horrible kludge
1220 (insert " ") 1240 (insert " ")
1221 (ada-adjust-case) 1241 (ada-adjust-case)
1222 ;; horrible dekludge 1242 ;; horrible De-kludge
1223 (delete-backward-char 1) 1243 (delete-backward-char 1)
1224 ;; some special keys and their bindings 1244 ;; some special keys and their bindings
1225 (cond 1245 (cond
@@ -1237,8 +1257,9 @@ If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH)
1237 1257
1238 1258
1239(defun ada-activate-keys-for-case () 1259(defun ada-activate-keys-for-case ()
1260 "Modifies the key bindings for all the keys that should readjust the casing."
1240 (interactive) 1261 (interactive)
1241 ;; save original keybindings to allow swapping ret/lfd 1262 ;; save original key bindings to allow swapping ret/lfd
1242 ;; when casing is activated 1263 ;; when casing is activated
1243 ;; the 'or ...' is there to be sure that the value will not 1264 ;; the 'or ...' is there to be sure that the value will not
1244 ;; be changed again when Ada mode is called more than once (MH) 1265 ;; be changed again when Ada mode is called more than once (MH)
@@ -1251,16 +1272,13 @@ If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH)
1251 ada-mode-map 1272 ada-mode-map
1252 (char-to-string key) 1273 (char-to-string key)
1253 'ada-adjust-case-interactive))) 1274 'ada-adjust-case-interactive)))
1254 '( ?` ?~ ?! ?@ ?# ?$ ?% ?^ ?& ?* ?( ?) ?- ?= ?+ ?[ ?{ ?] ?} 1275 '( ?` ?~ ?! ?_ ?@ ?# ?$ ?% ?^ ?& ?* ?( ?) ?- ?= ?+ ?[ ?{ ?] ?}
1255 ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r ))) 1276 ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r )))
1256 1277
1257;;
1258;; added by MH
1259;;
1260(defun ada-loose-case-word (&optional arg) 1278(defun ada-loose-case-word (&optional arg)
1261 "Capitalizes the first letter and the letters following `_' for the following 1279 "Upcase first letter and letters following `_' in the following word.
1262word. Ignores Arg (its there to conform to capitalize-word parameters) 1280No other letter is modified.
1263Does not change other letters" 1281ARG is ignored, and is there for compatibility with `capitalize-word' only."
1264 (interactive) 1282 (interactive)
1265 (let ((pos (point)) 1283 (let ((pos (point))
1266 (first t)) 1284 (first t))
@@ -1274,8 +1292,8 @@ Does not change other letters"
1274 (goto-char pos))) 1292 (goto-char pos)))
1275 1293
1276(defun ada-capitalize-word (&optional arg) 1294(defun ada-capitalize-word (&optional arg)
1277 "Capitalizes the first letter and the letters following '_', and 1295 "Upcase first letter and letters following '_', lower case other letters.
1278lower case other letters" 1296ARG is ignored, and is there for compatibility with `capitalize-word' only."
1279 (interactive) 1297 (interactive)
1280 (let ((pos (point))) 1298 (let ((pos (point)))
1281 (skip-syntax-backward "w") 1299 (skip-syntax-backward "w")
@@ -1284,12 +1302,8 @@ lower case other letters"
1284 (goto-char pos) 1302 (goto-char pos)
1285 (modify-syntax-entry ?_ "w"))) 1303 (modify-syntax-entry ?_ "w")))
1286 1304
1287;;
1288;; added by MH
1289;; modified by JSH to handle attributes
1290;;
1291(defun ada-adjust-case-region (from to) 1305(defun ada-adjust-case-region (from to)
1292 "Adjusts the case of all words in the region. 1306 "Adjusts the case of all words in the region between FROM and TO.
1293Attention: This function might take very long for big regions !" 1307Attention: This function might take very long for big regions !"
1294 (interactive "*r") 1308 (interactive "*r")
1295 (let ((begin nil) 1309 (let ((begin nil)
@@ -1334,10 +1348,6 @@ Attention: This function might take very long for big regions !"
1334 (message "Adjusting case ... Done")) 1348 (message "Adjusting case ... Done"))
1335 (set-syntax-table previous-syntax-table)))) 1349 (set-syntax-table previous-syntax-table))))
1336 1350
1337
1338;;
1339;; added by MH
1340;;
1341(defun ada-adjust-case-buffer () 1351(defun ada-adjust-case-buffer ()
1342 "Adjusts the case of all words in the whole buffer. 1352 "Adjusts the case of all words in the whole buffer.
1343ATTENTION: This function might take very long for big buffers !" 1353ATTENTION: This function might take very long for big buffers !"
@@ -1345,16 +1355,23 @@ ATTENTION: This function might take very long for big buffers !"
1345 (ada-adjust-case-region (point-min) (point-max))) 1355 (ada-adjust-case-region (point-min) (point-max)))
1346 1356
1347 1357
1348;;;------------------------;;; 1358;;--------------------------------------------------------------
1349;;; Format Parameter Lists ;;; 1359;; Format Parameter Lists
1350;;;------------------------;;; 1360;; Some special algorithms are provided to indent the parameter lists in
1351(defun ada-format-paramlist () 1361;; subprogram declarations. This is done in two steps:
1352 "Reformats a parameter list. 1362;; - First parses the parameter list. The returned list has the following
1353ATTENTION: 1) Comments inside the list are killed ! 1363;; format:
1354 2) If the syntax is not correct (especially, if there are 1364;; ( (<Param_Name> in? out? access? <Type_Name> <Default_Expression>)
1355 semicolons missing), it can get totally confused ! 1365;; ... )
1356In such a case, use `undo', correct the syntax and try again." 1366;; This is done in `ada-scan-paramlist'.
1367;; - Delete and recreate the parameter list in function
1368;; `ada-format-paramlist'.
1369;; Note: Comments inside the parameter list are lost.
1370;; The syntax has to be correct, or the reformating will fail.
1371;;--------------------------------------------------------------
1357 1372
1373(defun ada-format-paramlist ()
1374 "Reformats the parameter list point is in."
1358 (interactive) 1375 (interactive)
1359 (let ((begin nil) 1376 (let ((begin nil)
1360 (end nil) 1377 (end nil)
@@ -1368,61 +1385,40 @@ In such a case, use `undo', correct the syntax and try again."
1368 ;; check if really inside parameter list 1385 ;; check if really inside parameter list
1369 (or (ada-in-paramlist-p) 1386 (or (ada-in-paramlist-p)
1370 (error "not in parameter list")) 1387 (error "not in parameter list"))
1371 ;; 1388
1372 ;; find start of current parameter-list 1389 ;; find start of current parameter-list
1373 ;;
1374 (ada-search-ignore-string-comment 1390 (ada-search-ignore-string-comment
1375 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) 1391 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
1376 (down-list 1) 1392 (down-list 1)
1377 (backward-char 1) 1393 (backward-char 1)
1378 (set 'begin (point)) 1394 (set 'begin (point))
1379 1395
1380 ;;
1381 ;; find end of parameter-list 1396 ;; find end of parameter-list
1382 ;;
1383 (forward-sexp 1) 1397 (forward-sexp 1)
1384 (set 'delend (point)) 1398 (set 'delend (point))
1385 (delete-char -1) 1399 (delete-char -1)
1386 1400
1387 ;;
1388 ;; find end of last parameter-declaration 1401 ;; find end of last parameter-declaration
1389 ;;
1390 (forward-comment -1000) 1402 (forward-comment -1000)
1391 (set 'end (point)) 1403 (set 'end (point))
1392 1404
1393 ;;
1394 ;; build a list of all elements of the parameter-list 1405 ;; build a list of all elements of the parameter-list
1395 ;;
1396 (set 'paramlist (ada-scan-paramlist (1+ begin) end)) 1406 (set 'paramlist (ada-scan-paramlist (1+ begin) end))
1397 1407
1398 ;;
1399 ;; delete the original parameter-list 1408 ;; delete the original parameter-list
1400 ;;
1401 (delete-region begin (1- delend)) 1409 (delete-region begin (1- delend))
1402 1410
1403 ;;
1404 ;; insert the new parameter-list 1411 ;; insert the new parameter-list
1405 ;;
1406 (goto-char begin) 1412 (goto-char begin)
1407 (ada-insert-paramlist paramlist)) 1413 (ada-insert-paramlist paramlist))
1408 1414
1409 ;;
1410 ;; restore syntax-table 1415 ;; restore syntax-table
1411 ;;
1412 (set-syntax-table previous-syntax-table) 1416 (set-syntax-table previous-syntax-table)
1413 ))) 1417 )))
1414 1418
1415
1416(defun ada-scan-paramlist (begin end) 1419(defun ada-scan-paramlist (begin end)
1417 ;; Scans a parameter-list between BEGIN and END and returns a list 1420 "Scan the parameter list found in between BEGIN and END.
1418 ;; of its contents. 1421Returns the equivalent internal parameter list."
1419 ;; The list has the following format:
1420 ;;
1421 ;; Name of Param in? out? access? Name of Type Default-Exp or nil
1422 ;;
1423 ;; ( ('Name_Param_1' t nil t Type_Param_1 ':= expression')
1424 ;; ('Name_Param_2' nil nil t Type_Param_2 nil) )
1425
1426 (let ((paramlist (list)) 1422 (let ((paramlist (list))
1427 (param (list)) 1423 (param (list))
1428 (notend t) 1424 (notend t)
@@ -1432,20 +1428,15 @@ In such a case, use `undo', correct the syntax and try again."
1432 (match-cons nil)) 1428 (match-cons nil))
1433 1429
1434 (goto-char begin) 1430 (goto-char begin)
1435 ;; 1431
1436 ;; loop until end of last parameter 1432 ;; loop until end of last parameter
1437 ;;
1438 (while notend 1433 (while notend
1439 1434
1440 ;;
1441 ;; find first character of parameter-declaration 1435 ;; find first character of parameter-declaration
1442 ;;
1443 (ada-goto-next-non-ws) 1436 (ada-goto-next-non-ws)
1444 (set 'apos (point)) 1437 (set 'apos (point))
1445 1438
1446 ;;
1447 ;; find last character of parameter-declaration 1439 ;; find last character of parameter-declaration
1448 ;;
1449 (if (set 'match-cons 1440 (if (set 'match-cons
1450 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t)) 1441 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
1451 (progn 1442 (progn
@@ -1453,18 +1444,14 @@ In such a case, use `undo', correct the syntax and try again."
1453 (set 'semipos (cdr match-cons))) 1444 (set 'semipos (cdr match-cons)))
1454 (set 'epos end)) 1445 (set 'epos end))
1455 1446
1456 ;;
1457 ;; read name(s) of parameter(s) 1447 ;; read name(s) of parameter(s)
1458 ;;
1459 (goto-char apos) 1448 (goto-char apos)
1460 (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]") 1449 (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]")
1461 1450
1462 (set 'param (list (match-string 1))) 1451 (set 'param (list (match-string 1)))
1463 (ada-search-ignore-string-comment ":" nil epos t 'search-forward) 1452 (ada-search-ignore-string-comment ":" nil epos t 'search-forward)
1464 1453
1465 ;;
1466 ;; look for 'in' 1454 ;; look for 'in'
1467 ;;
1468 (set 'apos (point)) 1455 (set 'apos (point))
1469 (set 'param 1456 (set 'param
1470 (append param 1457 (append param
@@ -1473,9 +1460,7 @@ In such a case, use `undo', correct the syntax and try again."
1473 (ada-search-ignore-string-comment 1460 (ada-search-ignore-string-comment
1474 "in" nil epos t 'word-search-forward))))) 1461 "in" nil epos t 'word-search-forward)))))
1475 1462
1476 ;;
1477 ;; look for 'out' 1463 ;; look for 'out'
1478 ;;
1479 (goto-char apos) 1464 (goto-char apos)
1480 (set 'param 1465 (set 'param
1481 (append param 1466 (append param
@@ -1484,9 +1469,7 @@ In such a case, use `undo', correct the syntax and try again."
1484 (ada-search-ignore-string-comment 1469 (ada-search-ignore-string-comment
1485 "out" nil epos t 'word-search-forward))))) 1470 "out" nil epos t 'word-search-forward)))))
1486 1471
1487 ;;
1488 ;; look for 'access' 1472 ;; look for 'access'
1489 ;;
1490 (goto-char apos) 1473 (goto-char apos)
1491 (set 'param 1474 (set 'param
1492 (append param 1475 (append param
@@ -1495,26 +1478,20 @@ In such a case, use `undo', correct the syntax and try again."
1495 (ada-search-ignore-string-comment 1478 (ada-search-ignore-string-comment
1496 "access" nil epos t 'word-search-forward))))) 1479 "access" nil epos t 'word-search-forward)))))
1497 1480
1498 ;;
1499 ;; skip 'in'/'out'/'access' 1481 ;; skip 'in'/'out'/'access'
1500 ;;
1501 (goto-char apos) 1482 (goto-char apos)
1502 (ada-goto-next-non-ws) 1483 (ada-goto-next-non-ws)
1503 (while (looking-at "\\<\\(in\\|out\\|access\\)\\>") 1484 (while (looking-at "\\<\\(in\\|out\\|access\\)\\>")
1504 (forward-word 1) 1485 (forward-word 1)
1505 (ada-goto-next-non-ws)) 1486 (ada-goto-next-non-ws))
1506 1487
1507 ;;
1508 ;; read type of parameter 1488 ;; read type of parameter
1509 ;;
1510 (looking-at "\\<\\(\\sw\\|[_.']\\)+\\>") 1489 (looking-at "\\<\\(\\sw\\|[_.']\\)+\\>")
1511 (set 'param 1490 (set 'param
1512 (append param 1491 (append param
1513 (list (match-string 0)))) 1492 (list (match-string 0))))
1514 1493
1515 ;;
1516 ;; read default-expression, if there is one 1494 ;; read default-expression, if there is one
1517 ;;
1518 (goto-char (set 'apos (match-end 0))) 1495 (goto-char (set 'apos (match-end 0)))
1519 (set 'param 1496 (set 'param
1520 (append param 1497 (append param
@@ -1524,26 +1501,19 @@ In such a case, use `undo', correct the syntax and try again."
1524 ":=" nil epos t 'search-forward)) 1501 ":=" nil epos t 'search-forward))
1525 (buffer-substring (car match-cons) epos) 1502 (buffer-substring (car match-cons) epos)
1526 nil)))) 1503 nil))))
1527 ;; 1504
1528 ;; add this parameter-declaration to the list 1505 ;; add this parameter-declaration to the list
1529 ;;
1530 (set 'paramlist (append paramlist (list param))) 1506 (set 'paramlist (append paramlist (list param)))
1531 1507
1532 ;;
1533 ;; check if it was the last parameter 1508 ;; check if it was the last parameter
1534 ;;
1535 (if (eq epos end) 1509 (if (eq epos end)
1536 (set 'notend nil) 1510 (set 'notend nil)
1537 (goto-char semipos)) 1511 (goto-char semipos))
1538 1512 )
1539 ) ; end of loop
1540
1541 (reverse paramlist))) 1513 (reverse paramlist)))
1542 1514
1543
1544(defun ada-insert-paramlist (paramlist) 1515(defun ada-insert-paramlist (paramlist)
1545 ;; Inserts a formatted PARAMLIST in the buffer. 1516 "Inserts a formatted PARAMLIST in the buffer."
1546 ;; See doc of `ada-scan-paramlist' for the format.
1547 (let ((i (length paramlist)) 1517 (let ((i (length paramlist))
1548 (parlen 0) 1518 (parlen 0)
1549 (typlen 0) 1519 (typlen 0)
@@ -1554,54 +1524,27 @@ In such a case, use `undo', correct the syntax and try again."
1554 (column nil) 1524 (column nil)
1555 (firstcol nil)) 1525 (firstcol nil))
1556 1526
1557 ;;
1558 ;; loop until last parameter 1527 ;; loop until last parameter
1559 ;;
1560 (while (not (zerop i)) 1528 (while (not (zerop i))
1561 (set 'i (1- i)) 1529 (set 'i (1- i))
1562 1530
1563 ;;
1564 ;; get max length of parameter-name 1531 ;; get max length of parameter-name
1565 ;; 1532 (set 'parlen (max parlen (length (nth 0 (nth i paramlist)))))
1566 (set 'parlen
1567 (if (<= parlen (set 'temp
1568 (length (nth 0 (nth i paramlist)))))
1569 temp
1570 parlen))
1571 1533
1572 ;;
1573 ;; get max length of type-name 1534 ;; get max length of type-name
1574 ;; 1535 (set 'typlen (max typlen (length (nth 4 (nth i paramlist)))))
1575 (set 'typlen
1576 (if (<= typlen (set 'temp
1577 (length (nth 4 (nth i paramlist)))))
1578 temp
1579 typlen))
1580 1536
1581 ;;
1582 ;; is there any 'in' ? 1537 ;; is there any 'in' ?
1583 ;; 1538 (set 'inp (or inp (nth 1 (nth i paramlist))))
1584 (set 'inp
1585 (or inp
1586 (nth 1 (nth i paramlist))))
1587 1539
1588 ;;
1589 ;; is there any 'out' ? 1540 ;; is there any 'out' ?
1590 ;; 1541 (set 'outp (or outp (nth 2 (nth i paramlist))))
1591 (set 'outp
1592 (or outp
1593 (nth 2 (nth i paramlist))))
1594 1542
1595 ;;
1596 ;; is there any 'access' ? 1543 ;; is there any 'access' ?
1597 ;; 1544 (set 'accessp (or accessp (nth 3 (nth i paramlist))))
1598 (set 'accessp 1545 )
1599 (or accessp
1600 (nth 3 (nth i paramlist))))) ; end of loop
1601 1546
1602 ;;
1603 ;; does paramlist already start on a separate line ? 1547 ;; does paramlist already start on a separate line ?
1604 ;;
1605 (if (save-excursion 1548 (if (save-excursion
1606 (re-search-backward "^.\\|[^ \t]" nil t) 1549 (re-search-backward "^.\\|[^ \t]" nil t)
1607 (looking-at "^.")) 1550 (looking-at "^."))
@@ -1611,9 +1554,8 @@ In such a case, use `undo', correct the syntax and try again."
1611 (save-excursion 1554 (save-excursion
1612 (if (looking-at "\\(is\\|return\\)") 1555 (if (looking-at "\\(is\\|return\\)")
1613 (replace-match " \\1")))) 1556 (replace-match " \\1"))))
1614 ;; 1557
1615 ;; no => insert it where we are after removing any whitespace 1558 ;; no => insert it where we are after removing any whitespace
1616 ;;
1617 (fixup-whitespace) 1559 (fixup-whitespace)
1618 (save-excursion 1560 (save-excursion
1619 (cond 1561 (cond
@@ -1629,24 +1571,18 @@ In such a case, use `undo', correct the syntax and try again."
1629 (set 'firstcol (current-column)) 1571 (set 'firstcol (current-column))
1630 (set 'i (length paramlist)) 1572 (set 'i (length paramlist))
1631 1573
1632 ;;
1633 ;; loop until last parameter 1574 ;; loop until last parameter
1634 ;;
1635 (while (not (zerop i)) 1575 (while (not (zerop i))
1636 (set 'i (1- i)) 1576 (set 'i (1- i))
1637 (set 'column firstcol) 1577 (set 'column firstcol)
1638 1578
1639 ;;
1640 ;; insert parameter-name, space and colon 1579 ;; insert parameter-name, space and colon
1641 ;;
1642 (insert (nth 0 (nth i paramlist))) 1580 (insert (nth 0 (nth i paramlist)))
1643 (indent-to (+ column parlen 1)) 1581 (indent-to (+ column parlen 1))
1644 (insert ": ") 1582 (insert ": ")
1645 (set 'column (current-column)) 1583 (set 'column (current-column))
1646 1584
1647 ;;
1648 ;; insert 'in' or space 1585 ;; insert 'in' or space
1649 ;;
1650 (if (nth 1 (nth i paramlist)) 1586 (if (nth 1 (nth i paramlist))
1651 (insert "in ") 1587 (insert "in ")
1652 (if (and 1588 (if (and
@@ -1655,9 +1591,7 @@ In such a case, use `undo', correct the syntax and try again."
1655 (not (nth 3 (nth i paramlist)))) 1591 (not (nth 3 (nth i paramlist))))
1656 (insert " "))) 1592 (insert " ")))
1657 1593
1658 ;;
1659 ;; insert 'out' or space 1594 ;; insert 'out' or space
1660 ;;
1661 (if (nth 2 (nth i paramlist)) 1595 (if (nth 2 (nth i paramlist))
1662 (insert "out ") 1596 (insert "out ")
1663 (if (and 1597 (if (and
@@ -1666,41 +1600,32 @@ In such a case, use `undo', correct the syntax and try again."
1666 (not (nth 3 (nth i paramlist)))) 1600 (not (nth 3 (nth i paramlist))))
1667 (insert " "))) 1601 (insert " ")))
1668 1602
1669 ;;
1670 ;; insert 'access' 1603 ;; insert 'access'
1671 ;;
1672 (if (nth 3 (nth i paramlist)) 1604 (if (nth 3 (nth i paramlist))
1673 (insert "access ")) 1605 (insert "access "))
1674 1606
1675 (set 'column (current-column)) 1607 (set 'column (current-column))
1676 1608
1677 ;;
1678 ;; insert type-name and, if necessary, space and default-expression 1609 ;; insert type-name and, if necessary, space and default-expression
1679 ;;
1680 (insert (nth 4 (nth i paramlist))) 1610 (insert (nth 4 (nth i paramlist)))
1681 (if (nth 5 (nth i paramlist)) 1611 (if (nth 5 (nth i paramlist))
1682 (progn 1612 (progn
1683 (indent-to (+ column typlen 1)) 1613 (indent-to (+ column typlen 1))
1684 (insert (nth 5 (nth i paramlist))))) 1614 (insert (nth 5 (nth i paramlist)))))
1685 1615
1686 ;;
1687 ;; check if it was the last parameter 1616 ;; check if it was the last parameter
1688 ;;
1689 (if (zerop i) 1617 (if (zerop i)
1690 (insert ")") 1618 (insert ")")
1691 ;; no => insert ';' and newline and indent 1619 ;; no => insert ';' and newline and indent
1692 (insert ";") 1620 (insert ";")
1693 (newline) 1621 (newline)
1694 (indent-to firstcol)) 1622 (indent-to firstcol))
1695 ) ; end of loop 1623 )
1696 1624
1697 ;;
1698 ;; if anything follows, except semicolon, newline, is or return 1625 ;; if anything follows, except semicolon, newline, is or return
1699 ;; put it in a new line and indent it 1626 ;; put it in a new line and indent it
1700 ;;
1701 (unless (looking-at "[ \t]*\\(;\\|\n\\|is\\|return\\)") 1627 (unless (looking-at "[ \t]*\\(;\\|\n\\|is\\|return\\)")
1702 (ada-indent-newline-indent)) 1628 (ada-indent-newline-indent))
1703
1704 )) 1629 ))
1705 1630
1706 1631
@@ -1777,7 +1702,8 @@ Moves to 'begin' if in a declarative part."
1777 ((save-excursion 1702 ((save-excursion
1778 (and (ada-goto-stmt-start) 1703 (and (ada-goto-stmt-start)
1779 (looking-at "\\<function\\>\\|\\<procedure\\>" ))) 1704 (looking-at "\\<function\\>\\|\\<procedure\\>" )))
1780 (ada-search-ignore-string-comment "begin" nil nil nil 'word-search-forward)) 1705 (ada-search-ignore-string-comment "begin" nil nil nil
1706 'word-search-forward))
1781 ;; on first line of task declaration 1707 ;; on first line of task declaration
1782 ((save-excursion 1708 ((save-excursion
1783 (and (ada-goto-stmt-start) 1709 (and (ada-goto-stmt-start)
@@ -1785,7 +1711,8 @@ Moves to 'begin' if in a declarative part."
1785 (forward-word 1) 1711 (forward-word 1)
1786 (ada-goto-next-non-ws) 1712 (ada-goto-next-non-ws)
1787 (looking-at "\\<body\\>"))) 1713 (looking-at "\\<body\\>")))
1788 (ada-search-ignore-string-comment "begin" nil nil nil 'word-search-forward)) 1714 (ada-search-ignore-string-comment "begin" nil nil nil
1715 'word-search-forward))
1789 ;; accept block start 1716 ;; accept block start
1790 ((save-excursion 1717 ((save-excursion
1791 (and (ada-goto-stmt-start) 1718 (and (ada-goto-stmt-start)
@@ -1799,31 +1726,51 @@ Moves to 'begin' if in a declarative part."
1799 ;; inside a 'begin' ... 'end' block 1726 ;; inside a 'begin' ... 'end' block
1800 ((save-excursion 1727 ((save-excursion
1801 (ada-goto-matching-decl-start t)) 1728 (ada-goto-matching-decl-start t))
1802 (ada-search-ignore-string-comment "begin" nil nil nil 'word-search-forward)) 1729 (ada-search-ignore-string-comment "begin" nil nil nil
1730 'word-search-forward))
1803 ;; (hopefully ;-) everything else 1731 ;; (hopefully ;-) everything else
1804 (t 1732 (t
1805 (ada-goto-matching-end 1))) 1733 (ada-goto-matching-end 1)))
1806 (set 'pos (point)) 1734 (set 'pos (point))
1807 1735 )
1808 ) ; end of save-excursion
1809 1736
1810 ;; now really move to the found position 1737 ;; now really move to the found position
1811 (goto-char pos) 1738 (goto-char pos)
1812 (message "searching for block end ... done")) 1739 (message "searching for block end ... done"))
1813 1740
1814 ;;
1815 ;; restore syntax-table 1741 ;; restore syntax-table
1816 ;;
1817 (set-syntax-table previous-syntax-table)))) 1742 (set-syntax-table previous-syntax-table))))
1818 1743
1819 1744
1820;;;-----------------------------;;; 1745;;;----------------------------------------------------------------
1821;;; Functions For Indentation ;;; 1746;; Indentation Engine
1822;;;-----------------------------;;; 1747;; All indentations are indicated as a two-element string:
1748;; - position of reference in the buffer
1749;; - offset to indent from this position (can also be a symbol or a list
1750;; that are evaluated)
1751;; Thus the total indentation for a line is the column number of the reference
1752;; position plus whatever value the evaluation of the second element provides.
1753;; This mechanism is used so that the ada-mode can "explain" how the
1754;; indentation was calculated, by showing which variables were used.
1755;;
1756;; The indentation itself is done in only one pass: first we try to guess in
1757;; what context we are by looking at the following keyword or punctuation
1758;; sign. If nothing remarkable is found, just try to guess the indentation
1759;; based on previous lines.
1760;;
1761;; The relevant functions for indentation are:
1762;; - `ada-indent-region': Re-indent a region of text
1763;; - `ada-justified-indent-current': Re-indent the current line and shows the
1764;; calculation that were done
1765;; - `ada-indent-current': Re-indent the current line
1766;; - `ada-get-current-indent': Calculate the indentation for the current line,
1767;; based on the context (see above).
1768;; - `ada-get-indent-*': Calculate the indentation in a specific context.
1769;; For efficiency, these functions do not check the correct context.
1770;;;----------------------------------------------------------------
1823 1771
1824;; ---- main functions for indentation
1825(defun ada-indent-region (beg end) 1772(defun ada-indent-region (beg end)
1826 "Indents the region using `ada-indent-current' on each line." 1773 "Indent the region between BEG and END."
1827 (interactive "*r") 1774 (interactive "*r")
1828 (goto-char beg) 1775 (goto-char beg)
1829 (let ((block-done 0) 1776 (let ((block-done 0)
@@ -1851,18 +1798,16 @@ Moves to 'begin' if in a declarative part."
1851 (ada-indent-current)) 1798 (ada-indent-current))
1852 1799
1853(defun ada-indent-newline-indent-conditional () 1800(defun ada-indent-newline-indent-conditional ()
1854 "If `ada-indent-after-return' is non-nil, then indents the current line, 1801 "Insert a newline and indent it.
1855insert a newline and indents the newline. 1802The original line is indented first if `ada-indent-after-return' is non-nil.
1856If `ada-indent-after-return' is nil then inserts a newline and indents the 1803This function is intended to be bound to the \C-m and \C-j keys."
1857newline.
1858This function is intended to be bound to the \C-m and \C-j keys"
1859 (interactive "*") 1804 (interactive "*")
1860 (if ada-indent-after-return (ada-indent-current)) 1805 (if ada-indent-after-return (ada-indent-current))
1861 (newline) 1806 (newline)
1862 (ada-indent-current)) 1807 (ada-indent-current))
1863 1808
1864(defun ada-justified-indent-current () 1809(defun ada-justified-indent-current ()
1865 "Indent the current line and explains how it was chosen" 1810 "Indent the current line and explains how the calculation was done."
1866 (interactive) 1811 (interactive)
1867 1812
1868 (let ((cur-indent (ada-indent-current))) 1813 (let ((cur-indent (ada-indent-current)))
@@ -1886,12 +1831,9 @@ This function is intended to be bound to the \C-m and \C-j keys"
1886 (sit-for 1)))) 1831 (sit-for 1))))
1887 1832
1888(defun ada-indent-current () 1833(defun ada-indent-current ()
1889 "Indents current line as Ada code. 1834 "Indent current line as Ada code.
1890Each of these steps returns a two element list: 1835Returns the calculation that was done, including the reference point and the
1891 - position of reference in the buffer 1836offset."
1892 - offset to indent from this position (can also be a symbol or a list
1893 that are evaluated"
1894
1895 (interactive) 1837 (interactive)
1896 (let ((previous-syntax-table (syntax-table)) 1838 (let ((previous-syntax-table (syntax-table))
1897 (orgpoint (point-marker)) 1839 (orgpoint (point-marker))
@@ -1922,7 +1864,8 @@ Each of these steps returns a two element list:
1922 1864
1923 ;; Evaluate the list to get the column to indent to 1865 ;; Evaluate the list to get the column to indent to
1924 ;; prev-indent contains the column to indent to 1866 ;; prev-indent contains the column to indent to
1925 (set 'prev-indent (save-excursion (goto-char (car cur-indent)) (current-column))) 1867 (set 'prev-indent (save-excursion (goto-char (car cur-indent))
1868 (current-column)))
1926 (set 'tmp-indent (cdr cur-indent)) 1869 (set 'tmp-indent (cdr cur-indent))
1927 (while (not (null tmp-indent)) 1870 (while (not (null tmp-indent))
1928 (cond 1871 (cond
@@ -1933,7 +1876,7 @@ Each of these steps returns a two element list:
1933 ) 1876 )
1934 (set 'tmp-indent (cdr tmp-indent))) 1877 (set 'tmp-indent (cdr tmp-indent)))
1935 1878
1936 ;; only reindent if indentation is different then the current 1879 ;; only re-indent if indentation is different then the current
1937 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent) 1880 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent)
1938 nil 1881 nil
1939 (beginning-of-line) 1882 (beginning-of-line)
@@ -1945,24 +1888,16 @@ Each of these steps returns a two element list:
1945 (goto-char orgpoint) 1888 (goto-char orgpoint)
1946 (if (< (current-column) (current-indentation)) 1889 (if (< (current-column) (current-indentation))
1947 (back-to-indentation)))) 1890 (back-to-indentation))))
1948 ;; 1891
1949 ;; restore syntax-table 1892 ;; restore syntax-table
1950 ;;
1951 (if ada-xemacs 1893 (if ada-xemacs
1952 (ad-deactivate 'parse-partial-sexp)) 1894 (ad-deactivate 'parse-partial-sexp))
1953 (set-syntax-table previous-syntax-table) 1895 (set-syntax-table previous-syntax-table)
1954 cur-indent 1896 cur-indent
1955 )) 1897 ))
1956 1898
1957
1958(defun ada-get-current-indent () 1899(defun ada-get-current-indent ()
1959 "Returns the column number to indent the current line to. 1900 "Returns the indentation to use for the current line."
1960
1961Returns a list of two elements (same as prev-indent):
1962 - Position in the cursor that is used as a reference (its columns
1963 is used)
1964 - variable used to calculate the indentation from position"
1965
1966 (let (column 1901 (let (column
1967 pos 1902 pos
1968 match-cons 1903 match-cons
@@ -2224,22 +2159,16 @@ Returns a list of two elements (same as prev-indent):
2224 (ada-indent-on-previous-lines nil orgpoint orgpoint))) 2159 (ada-indent-on-previous-lines nil orgpoint orgpoint)))
2225 (list (save-excursion (back-to-indentation) (point)) 0))) 2160 (list (save-excursion (back-to-indentation) (point)) 0)))
2226 ;; 2161 ;;
2227 ;; unknown syntax - maybe this should signal an error ? 2162 ;; unknown syntax
2228 ;; 2163 ;;
2229 (t 2164 (t
2230 (ada-indent-on-previous-lines nil orgpoint orgpoint))))) 2165 (ada-indent-on-previous-lines nil orgpoint orgpoint)))))
2231 2166
2232(defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos) 2167(defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos)
2233 "Calculate the indentation of the current line, based on the previous lines 2168 "Calculate the indentation for the new line after ORGPOINT.
2234in the buffer. This function does not pay any attention to the current line, 2169The result list is based on the previous lines in the buffer.
2235since this is the role of the second step in the indentation 2170If NOMOVE is nil, moves point to the beginning of the current statement.
2236 (see ada-get-current-indent). 2171if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
2237
2238Returns a two element list:
2239 - position of reference in the buffer
2240 - offset to indent from this position (can also be a symbol or a list
2241 that are evaluated)
2242Moves point to the beginning of the current statement, if NOMOVE is nil."
2243 (if initial-pos 2172 (if initial-pos
2244 (goto-char initial-pos)) 2173 (goto-char initial-pos))
2245 (let ((oldpoint (point)) 2174 (let ((oldpoint (point))
@@ -2248,7 +2177,7 @@ Moves point to the beginning of the current statement, if NOMOVE is nil."
2248 ;; Is inside a parameter-list ? 2177 ;; Is inside a parameter-list ?
2249 ;; 2178 ;;
2250 (if (ada-in-paramlist-p) 2179 (if (ada-in-paramlist-p)
2251 (set 'result (ada-get-indent-paramlist orgpoint)) 2180 (set 'result (ada-get-indent-paramlist))
2252 2181
2253 ;; 2182 ;;
2254 ;; move to beginning of current statement 2183 ;; move to beginning of current statement
@@ -2263,14 +2192,14 @@ Moves point to the beginning of the current statement, if NOMOVE is nil."
2263 ;; 2192 ;;
2264 (if (and (eq oldpoint (point)) 2193 (if (and (eq oldpoint (point))
2265 (not nomove)) 2194 (not nomove))
2266 (set 'result (ada-get-indent-nochange orgpoint)) 2195 (set 'result (ada-get-indent-nochange))
2267 2196
2268 (cond 2197 (cond
2269 ;; 2198 ;;
2270 ((and 2199 ((and
2271 ada-indent-to-open-paren 2200 ada-indent-to-open-paren
2272 (ada-in-open-paren-p)) 2201 (ada-in-open-paren-p))
2273 (set 'result (ada-get-indent-open-paren orgpoint))) 2202 (set 'result (ada-get-indent-open-paren)))
2274 ;; 2203 ;;
2275 ((looking-at "end\\>") 2204 ((looking-at "end\\>")
2276 (set 'result (ada-get-indent-end orgpoint))) 2205 (set 'result (ada-get-indent-end orgpoint)))
@@ -2300,63 +2229,48 @@ Moves point to the beginning of the current statement, if NOMOVE is nil."
2300 (set 'result (ada-get-indent-label orgpoint))) 2229 (set 'result (ada-get-indent-label orgpoint)))
2301 ;; 2230 ;;
2302 ((looking-at "separate\\>") 2231 ((looking-at "separate\\>")
2303 (set 'result (ada-get-indent-nochange orgpoint))) 2232 (set 'result (ada-get-indent-nochange)))
2304 (t 2233 (t
2305 (set 'result (ada-get-indent-noindent orgpoint)))))))) 2234 (set 'result (ada-get-indent-noindent orgpoint))))))))
2306 2235
2307 result)) 2236 result))
2308 2237
2309 2238(defun ada-get-indent-open-paren ()
2310;; ---- functions to return indentation for special cases 2239 "Calculates the indentation when point is behind an unclosed parenthesis."
2311
2312(defun ada-get-indent-open-paren (orgpoint)
2313 "Returns the two element list for the indentation, when point is
2314behind an open parenthesis not yet closed"
2315 (list (ada-in-open-paren-p) 0)) 2240 (list (ada-in-open-paren-p) 0))
2316 2241
2317 2242(defun ada-get-indent-nochange ()
2318(defun ada-get-indent-nochange (orgpoint) 2243 "Return the current indentation of the previous line."
2319 "Returns the two element list for the indentation of the current line"
2320 (save-excursion 2244 (save-excursion
2321 (forward-line -1) 2245 (forward-line -1)
2322 (list (progn (back-to-indentation) (point)) 0))) 2246 (back-to-indentation)
2323 2247 (list (point) 0)))
2324 2248
2325(defun ada-get-indent-paramlist (orgpoint) 2249(defun ada-get-indent-paramlist ()
2326 "Returns the classical two position list for indentation for the new line 2250 "Calculates the indentation when point is inside a parameter list."
2327after ORGPOINT.
2328Assumes point to be inside a parameter list"
2329 (save-excursion 2251 (save-excursion
2330 (ada-search-ignore-string-comment "[^ \t\n]" t nil t) 2252 (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
2331 (cond 2253 (cond
2332 ;;
2333 ;; in front of the first parameter 2254 ;; in front of the first parameter
2334 ;;
2335 ((= (char-after) ?\() 2255 ((= (char-after) ?\()
2336 (goto-char (match-end 0)) 2256 (goto-char (match-end 0))
2337 (list (point) 0)) 2257 (list (point) 0))
2338 ;; 2258
2339 ;; in front of another parameter 2259 ;; in front of another parameter
2340 ;;
2341 ((= (char-after) ?\;) 2260 ((= (char-after) ?\;)
2342 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) 2261 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2343 (ada-goto-next-non-ws) 2262 (ada-goto-next-non-ws)
2344 (list (point) 0)) 2263 (list (point) 0))
2345 ;; 2264
2346 ;; inside a parameter declaration 2265 ;; inside a parameter declaration
2347 ;;
2348 (t 2266 (t
2349 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t))) 2267 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2350 (ada-goto-next-non-ws) 2268 (ada-goto-next-non-ws)
2351 (list (point) 'ada-broken-indent))))) 2269 (list (point) 'ada-broken-indent)))))
2352 2270
2353 2271(defun ada-get-indent-end (orgpoint)
2354(defun ada-get-indent-end (orgpoint &optional do-not-check-start) 2272 "Calculates the indentation when point is just before an end_statement.
2355 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2273ORGPOINT is the limit position used in the calculation."
2356 ;; Assumes point to be at the beginning of an end-statement.
2357 ;; Therefore it has to find the corresponding start. This can be a little
2358 ;; slow, if it has to search through big files with many nested blocks.
2359 ;; Signals an error if the corresponding block-start doesn't match.
2360 (let ((defun-name nil) 2274 (let ((defun-name nil)
2361 (label 0) 2275 (label 0)
2362 (indent nil)) 2276 (indent nil))
@@ -2364,7 +2278,8 @@ Assumes point to be inside a parameter list"
2364 ;; is the line already terminated by ';' ? 2278 ;; is the line already terminated by ';' ?
2365 ;; 2279 ;;
2366 (if (save-excursion 2280 (if (save-excursion
2367 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward)) 2281 (ada-search-ignore-string-comment ";" nil orgpoint nil
2282 'search-forward))
2368 ;; 2283 ;;
2369 ;; yes, look what's following 'end' 2284 ;; yes, look what's following 'end'
2370 ;; 2285 ;;
@@ -2373,8 +2288,7 @@ Assumes point to be inside a parameter list"
2373 (ada-goto-next-non-ws) 2288 (ada-goto-next-non-ws)
2374 (cond 2289 (cond
2375 ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>") 2290 ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>")
2376 (unless do-not-check-start 2291 (save-excursion (ada-check-matching-start (match-string 0)))
2377 (save-excursion (ada-check-matching-start (match-string 0))))
2378 (list (save-excursion (back-to-indentation) (point)) 0)) 2292 (list (save-excursion (back-to-indentation) (point)) 0))
2379 2293
2380 ;; 2294 ;;
@@ -2394,39 +2308,36 @@ Assumes point to be inside a parameter list"
2394 ;; a named block end 2308 ;; a named block end
2395 ;; 2309 ;;
2396 ((looking-at ada-ident-re) 2310 ((looking-at ada-ident-re)
2397 (unless do-not-check-start 2311 (set 'defun-name (match-string 0))
2398 (progn 2312 (save-excursion
2399 (set 'defun-name (match-string 0)) 2313 (ada-goto-matching-start 0)
2400 (save-excursion 2314 (ada-check-defun-name defun-name))
2401 (ada-goto-matching-start 0)
2402 (ada-check-defun-name defun-name))))
2403 (list (progn (back-to-indentation) (point)) 0)) 2315 (list (progn (back-to-indentation) (point)) 0))
2404 ;; 2316 ;;
2405 ;; a block-end without name 2317 ;; a block-end without name
2406 ;; 2318 ;;
2407 ((= (char-after) ?\;) 2319 ((= (char-after) ?\;)
2408 (unless do-not-check-start 2320 (save-excursion
2409 (save-excursion 2321 (ada-goto-matching-start 0)
2410 (ada-goto-matching-start 0) 2322 (if (looking-at "\\<begin\\>")
2411 (if (looking-at "\\<begin\\>") 2323 (progn
2412 (progn 2324 (set 'indent (list (point) 0))
2413 (set 'indent (list (point) 0)) 2325 (if (ada-goto-matching-decl-start t)
2414 (if (ada-goto-matching-decl-start t) 2326 (list (progn (back-to-indentation) (point)) 0)
2415 (list (progn (back-to-indentation) (point)) 0) 2327 indent)))))
2416 indent))))
2417 (list (progn (back-to-indentation) (point)) 0)))
2418 ;; 2328 ;;
2419 ;; anything else - should maybe signal an error ? 2329 ;; anything else - should maybe signal an error ?
2420 ;; 2330 ;;
2421 (t 2331 (t
2422 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)))) 2332 (list (save-excursion (back-to-indentation) (point))
2423 2333 'ada-broken-indent))))
2424 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))))
2425 2334
2335 (list (save-excursion (back-to-indentation) (point))
2336 'ada-broken-indent))))
2426 2337
2427(defun ada-get-indent-case (orgpoint) 2338(defun ada-get-indent-case (orgpoint)
2428 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2339 "Calculates the indentation when point is just before a case statement.
2429 ;; Assumes point to be at the beginning of a case-statement. 2340ORGPOINT is the limit position used in the calculation."
2430 (let ((match-cons nil) 2341 (let ((match-cons nil)
2431 (opos (point))) 2342 (opos (point)))
2432 (cond 2343 (cond
@@ -2464,22 +2375,20 @@ Assumes point to be inside a parameter list"
2464 ;; incomplete case 2375 ;; incomplete case
2465 ;; 2376 ;;
2466 (t 2377 (t
2467 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))))) 2378 (list (save-excursion (back-to-indentation) (point))
2468 2379 'ada-broken-indent)))))
2469 2380
2470(defun ada-get-indent-when (orgpoint) 2381(defun ada-get-indent-when (orgpoint)
2471 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2382 "Calcules the indentation when point is just before a when statement.
2472 ;; Assumes point to be at the beginning of an when-statement. 2383ORGPOINT is the limit position used in the calculation."
2473 (let ((cur-indent (save-excursion (back-to-indentation) (point)))) 2384 (let ((cur-indent (save-excursion (back-to-indentation) (point))))
2474 (if (ada-search-ignore-string-comment 2385 (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint)
2475 "[ \t\n]*=>" nil orgpoint)
2476 (list cur-indent 'ada-indent) 2386 (list cur-indent 'ada-indent)
2477 (list cur-indent 'ada-broken-indent)))) 2387 (list cur-indent 'ada-broken-indent))))
2478 2388
2479
2480(defun ada-get-indent-if (orgpoint) 2389(defun ada-get-indent-if (orgpoint)
2481 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2390 "Calculates the indentation when point is just before an if statement.
2482 ;; Assumes point to be at the beginning of an if-statement. 2391ORGPOINT is the limit position used in the calculation."
2483 (let ((cur-indent (save-excursion (back-to-indentation) (point))) 2392 (let ((cur-indent (save-excursion (back-to-indentation) (point)))
2484 (match-cons nil)) 2393 (match-cons nil))
2485 ;; 2394 ;;
@@ -2507,11 +2416,9 @@ Assumes point to be inside a parameter list"
2507 2416
2508 (list cur-indent 'ada-broken-indent)))) 2417 (list cur-indent 'ada-broken-indent))))
2509 2418
2510
2511(defun ada-get-indent-block-start (orgpoint) 2419(defun ada-get-indent-block-start (orgpoint)
2512 ;; Returns the indentation (column #) for the new line after 2420 "Calculates the indentation when point is at the start of a block.
2513 ;; ORGPOINT. Assumes point to be at the beginning of a block start 2421ORGPOINT is the limit position used in the calculation."
2514 ;; keyword.
2515 (let ((pos nil)) 2422 (let ((pos nil))
2516 (cond 2423 (cond
2517 ((save-excursion 2424 ((save-excursion
@@ -2520,16 +2427,14 @@ Assumes point to be inside a parameter list"
2520 (goto-char pos) 2427 (goto-char pos)
2521 (save-excursion 2428 (save-excursion
2522 (ada-indent-on-previous-lines t orgpoint))) 2429 (ada-indent-on-previous-lines t orgpoint)))
2523 ;; 2430
2524 ;; nothing follows the block-start 2431 ;; nothing follows the block-start
2525 ;;
2526 (t 2432 (t
2527 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))))) 2433 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
2528 2434
2529
2530(defun ada-get-indent-subprog (orgpoint) 2435(defun ada-get-indent-subprog (orgpoint)
2531 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2436 "Calculates the indentation when point is just before a subprogram.
2532 ;; Assumes point to be at the beginning of a subprog-/package-declaration. 2437ORGPOINT is the limit position used in the calculation."
2533 (let ((match-cons nil) 2438 (let ((match-cons nil)
2534 (cur-indent (save-excursion (back-to-indentation) (point))) 2439 (cur-indent (save-excursion (back-to-indentation) (point)))
2535 (foundis nil)) 2440 (foundis nil))
@@ -2588,7 +2493,8 @@ Assumes point to be inside a parameter list"
2588 ;; no 'is' but ';' 2493 ;; no 'is' but ';'
2589 ;; 2494 ;;
2590 ((save-excursion 2495 ((save-excursion
2591 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward)) 2496 (ada-search-ignore-string-comment ";" nil orgpoint nil
2497 'search-forward))
2592 (list cur-indent 0)) 2498 (list cur-indent 0))
2593 ;; 2499 ;;
2594 ;; no 'is' or ';' 2500 ;; no 'is' or ';'
@@ -2596,10 +2502,9 @@ Assumes point to be inside a parameter list"
2596 (t 2502 (t
2597 (list cur-indent 'ada-broken-indent))))) 2503 (list cur-indent 'ada-broken-indent)))))
2598 2504
2599
2600(defun ada-get-indent-noindent (orgpoint) 2505(defun ada-get-indent-noindent (orgpoint)
2601 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2506 "Calculates the indentation when point is just before a 'noindent stmt'.
2602 ;; Assumes point to be at the beginning of a 'noindent statement'. 2507ORGPOINT is the limit position used in the calculation."
2603 (let ((label 0)) 2508 (let ((label 0))
2604 (save-excursion 2509 (save-excursion
2605 (beginning-of-line) 2510 (beginning-of-line)
@@ -2613,7 +2518,7 @@ Assumes point to be inside a parameter list"
2613 (ada-previous-procedure) 2518 (ada-previous-procedure)
2614 (list (save-excursion (back-to-indentation) (point)) 0)) 2519 (list (save-excursion (back-to-indentation) (point)) 0))
2615 2520
2616 ;; This one is called when indenting the second line of a multiline 2521 ;; This one is called when indenting the second line of a multi-line
2617 ;; declaration section, in a declare block or a record declaration 2522 ;; declaration section, in a declare block or a record declaration
2618 ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$") 2523 ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$")
2619 (list (save-excursion (back-to-indentation) (point)) 2524 (list (save-excursion (back-to-indentation) (point))
@@ -2644,23 +2549,23 @@ Assumes point to be inside a parameter list"
2644 'ada-broken-indent))))))) 2549 'ada-broken-indent)))))))
2645 2550
2646(defun ada-get-indent-label (orgpoint) 2551(defun ada-get-indent-label (orgpoint)
2647 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2552 "Calculates the indentation when before a label or variable declaration.
2648 ;; Assumes point to be at the beginning of a label or variable declaration. 2553ORGPOINT is the limit position used in the calculation."
2649 ;; Checks the context to decide if it's a label or a variable declaration.
2650 ;; This check might be a bit slow.
2651 (let ((match-cons nil) 2554 (let ((match-cons nil)
2652 (cur-indent (save-excursion (back-to-indentation) (point)))) 2555 (cur-indent (save-excursion (back-to-indentation) (point))))
2653 (ada-search-ignore-string-comment ":" nil) 2556 (ada-search-ignore-string-comment ":" nil)
2654 (cond 2557 (cond
2655 ;; loop label 2558 ;; loop label
2656 ((save-excursion 2559 ((save-excursion
2657 (set 'match-cons (ada-search-ignore-string-comment ada-loop-start-re nil orgpoint))) 2560 (set 'match-cons (ada-search-ignore-string-comment
2561 ada-loop-start-re nil orgpoint)))
2658 (goto-char (car match-cons)) 2562 (goto-char (car match-cons))
2659 (ada-get-indent-loop orgpoint)) 2563 (ada-get-indent-loop orgpoint))
2660 2564
2661 ;; declare label 2565 ;; declare label
2662 ((save-excursion 2566 ((save-excursion
2663 (set 'match-cons (ada-search-ignore-string-comment "\\<declare\\|begin\\>" nil orgpoint))) 2567 (set 'match-cons (ada-search-ignore-string-comment
2568 "\\<declare\\|begin\\>" nil orgpoint)))
2664 (goto-char (car match-cons)) 2569 (goto-char (car match-cons))
2665 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) 2570 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
2666 2571
@@ -2676,9 +2581,8 @@ Assumes point to be inside a parameter list"
2676 (list cur-indent '(- ada-label-indent)))))) 2581 (list cur-indent '(- ada-label-indent))))))
2677 2582
2678(defun ada-get-indent-loop (orgpoint) 2583(defun ada-get-indent-loop (orgpoint)
2679 "Returns the two-element list for indentation. 2584 "Calculates the indentation when just before a loop or a for ... use.
2680Assumes point to be at the beginning of a loop statement 2585ORGPOINT is the limit position used in the calculation."
2681or a for ... use statement."
2682 (let ((match-cons nil) 2586 (let ((match-cons nil)
2683 (pos (point)) 2587 (pos (point))
2684 2588
@@ -2695,7 +2599,8 @@ or a for ... use statement."
2695 ;; statement complete 2599 ;; statement complete
2696 ;; 2600 ;;
2697 ((save-excursion 2601 ((save-excursion
2698 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward)) 2602 (ada-search-ignore-string-comment ";" nil orgpoint nil
2603 'search-forward))
2699 (list (+ (save-excursion (back-to-indentation) (point)) label) 0)) 2604 (list (+ (save-excursion (back-to-indentation) (point)) label) 0))
2700 ;; 2605 ;;
2701 ;; simple loop 2606 ;; simple loop
@@ -2747,12 +2652,14 @@ or a for ... use statement."
2747 (back-to-indentation) 2652 (back-to-indentation)
2748 (looking-at "\\<loop\\>")) 2653 (looking-at "\\<loop\\>"))
2749 (goto-char pos)) 2654 (goto-char pos))
2750 (list (+ (save-excursion (back-to-indentation) (point)) label) 'ada-indent)) 2655 (list (+ (save-excursion (back-to-indentation) (point)) label)
2656 'ada-indent))
2751 ;; 2657 ;;
2752 ;; for-statement is broken 2658 ;; for-statement is broken
2753 ;; 2659 ;;
2754 (t 2660 (t
2755 (list (+ (save-excursion (back-to-indentation) (point)) label) 'ada-broken-indent)))) 2661 (list (+ (save-excursion (back-to-indentation) (point)) label)
2662 'ada-broken-indent))))
2756 2663
2757 ;; 2664 ;;
2758 ;; 'while'-loop 2665 ;; 'while'-loop
@@ -2775,15 +2682,16 @@ or a for ... use statement."
2775 (back-to-indentation) 2682 (back-to-indentation)
2776 (looking-at "\\<loop\\>")) 2683 (looking-at "\\<loop\\>"))
2777 (goto-char pos)) 2684 (goto-char pos))
2778 (list (+ (save-excursion (back-to-indentation) (point)) label) 'ada-indent)) 2685 (list (+ (save-excursion (back-to-indentation) (point)) label)
2686 'ada-indent))
2779 2687
2780 (list (+ (save-excursion (back-to-indentation) (point)) label) 2688 (list (+ (save-excursion (back-to-indentation) (point)) label)
2781 'ada-broken-indent)))))) 2689 'ada-broken-indent))))))
2782 2690
2783 2691
2784(defun ada-get-indent-type (orgpoint) 2692(defun ada-get-indent-type (orgpoint)
2785 ;; Returns the indentation (column #) for the new line after ORGPOINT. 2693 "Calculates the indentation when before a type statement.
2786 ;; Assumes point to be at the beginning of a type statement. 2694ORGPOINT is the limit position used in the calculation."
2787 (let ((match-dat nil)) 2695 (let ((match-dat nil))
2788 (cond 2696 (cond
2789 ;; 2697 ;;
@@ -2812,39 +2720,39 @@ or a for ... use statement."
2812 ;; complete type declaration 2720 ;; complete type declaration
2813 ;; 2721 ;;
2814 ((save-excursion 2722 ((save-excursion
2815 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward)) 2723 (ada-search-ignore-string-comment ";" nil orgpoint nil
2724 'search-forward))
2816 (list (save-excursion (back-to-indentation) (point)) 0)) 2725 (list (save-excursion (back-to-indentation) (point)) 0))
2817 ;; 2726 ;;
2818 ;; "type ... is", but not "type ... is ...", which is broken 2727 ;; "type ... is", but not "type ... is ...", which is broken
2819 ;; 2728 ;;
2820 ((save-excursion 2729 ((save-excursion
2821 (and 2730 (and
2822 (ada-search-ignore-string-comment "is" nil orgpoint nil 'word-search-forward) 2731 (ada-search-ignore-string-comment "is" nil orgpoint nil
2732 'word-search-forward)
2823 (not (ada-goto-next-non-ws orgpoint)))) 2733 (not (ada-goto-next-non-ws orgpoint))))
2824 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) 2734 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
2825 ;; 2735 ;;
2826 ;; broken statement 2736 ;; broken statement
2827 ;; 2737 ;;
2828 (t 2738 (t
2829 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))))) 2739 (list (save-excursion (back-to-indentation) (point))
2740 'ada-broken-indent)))))
2830 2741
2831 2742
2832;;; ---- support-functions for indentation 2743;; -----------------------------------------------------------
2833 2744;; -- searching and matching
2834;;; ---- searching and matching 2745;; -----------------------------------------------------------
2835 2746
2836(defun ada-goto-stmt-start (&optional limit) 2747(defun ada-goto-stmt-start ()
2837 ;; Moves point to the beginning of the statement that point is in or 2748 "Moves point to the beginning of the statement that point is in or after.
2838 ;; after. Returns the new position of point. Beginnings are found 2749Returns the new position of point.
2839 ;; by searching for 'ada-end-stmt-re' and then moving to the 2750As a special case, if we are looking at a closing parenthesis, skip to the
2840 ;; following non-ws that is not a comment. LIMIT is actually not 2751open parenthesis."
2841 ;; used by the indentation functions.
2842 ;; As a special case, if we are looking back at a closing parenthesis,
2843 ;; we just skip the parenthesis
2844 (let ((match-dat nil) 2752 (let ((match-dat nil)
2845 (orgpoint (point))) 2753 (orgpoint (point)))
2846 2754
2847 (set 'match-dat (ada-search-prev-end-stmt limit)) 2755 (set 'match-dat (ada-search-prev-end-stmt))
2848 (if match-dat 2756 (if match-dat
2849 2757
2850 ;; 2758 ;;
@@ -2859,7 +2767,7 @@ or a for ... use statement."
2859 ;; nothing follows => it's the end-statement directly in 2767 ;; nothing follows => it's the end-statement directly in
2860 ;; front of point => search again 2768 ;; front of point => search again
2861 ;; 2769 ;;
2862 (set 'match-dat (ada-search-prev-end-stmt limit))) 2770 (set 'match-dat (ada-search-prev-end-stmt)))
2863 ;; 2771 ;;
2864 ;; if found the correct end-statement => goto next non-ws 2772 ;; if found the correct end-statement => goto next non-ws
2865 ;; 2773 ;;
@@ -2883,12 +2791,10 @@ or a for ... use statement."
2883 (point))) 2791 (point)))
2884 2792
2885 2793
2886(defun ada-search-prev-end-stmt (&optional limit) 2794(defun ada-search-prev-end-stmt ()
2887 ;; Moves point to previous end-statement. Returns a cons cell whose 2795 "Moves point to previous end-statement.
2888 ;; car is the beginning and whose cdr the end of the match. 2796Returns a cons cell whose car is the beginning and whose cdr the end of the
2889 ;; End-statements are defined by 'ada-end-stmt-re'. Checks for 2797match."
2890 ;; certain keywords if they follow 'end', which means they are no
2891 ;; end-statement there.
2892 (let ((match-dat nil) 2798 (let ((match-dat nil)
2893 (found nil) 2799 (found nil)
2894 parse) 2800 parse)
@@ -2900,7 +2806,7 @@ or a for ... use statement."
2900 (and 2806 (and
2901 (not found) 2807 (not found)
2902 (set 'match-dat (ada-search-ignore-string-comment 2808 (set 'match-dat (ada-search-ignore-string-comment
2903 ada-end-stmt-re t limit))) 2809 ada-end-stmt-re t)))
2904 2810
2905 (goto-char (car match-dat)) 2811 (goto-char (car match-dat))
2906 (unless (ada-in-open-paren-p) 2812 (unless (ada-in-open-paren-p)
@@ -2919,7 +2825,8 @@ or a for ... use statement."
2919 (unless (looking-at 2825 (unless (looking-at
2920 (eval-when-compile 2826 (eval-when-compile
2921 (concat "\\<" 2827 (concat "\\<"
2922 (regexp-opt '("separate" "access" "array" "abstract" "new") t) 2828 (regexp-opt '("separate" "access" "array"
2829 "abstract" "new") t)
2923 "\\>\\|("))) 2830 "\\>\\|(")))
2924 (set 'found t)))) 2831 (set 'found t))))
2925 )) 2832 ))
@@ -2930,9 +2837,8 @@ or a for ... use statement."
2930 2837
2931 2838
2932(defun ada-goto-next-non-ws (&optional limit) 2839(defun ada-goto-next-non-ws (&optional limit)
2933 "Skips whitespaces, newlines and comments to next non-ws 2840 "Skips white spaces, newlines and comments to next non-ws character.
2934character. Signals an error if there is no more such character 2841Stop the search at LIMIT.
2935and limit is nil.
2936Do not call this function from within a string." 2842Do not call this function from within a string."
2937 (unless limit 2843 (unless limit
2938 (set 'limit (point-max))) 2844 (set 'limit (point-max)))
@@ -2949,17 +2855,18 @@ Do not call this function from within a string."
2949 2855
2950 2856
2951(defun ada-goto-stmt-end (&optional limit) 2857(defun ada-goto-stmt-end (&optional limit)
2952 ;; Moves point to the end of the statement that point is in or 2858 "Moves point to the end of the statement that point is in or before.
2953 ;; before. Returns the new position of point or nil if not found. 2859Returns the new position of point or nil if not found.
2860Stop the search at LIMIT."
2954 (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit) 2861 (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
2955 (point) 2862 (point)
2956 nil)) 2863 nil))
2957 2864
2958 2865
2959(defun ada-goto-next-word (&optional backward) 2866(defun ada-goto-next-word (&optional backward)
2960 ;; Moves point to the beginning of the next word of Ada code. 2867 "Moves point to the beginning of the next word of Ada code.
2961 ;; If BACKWARD is non-nil, jump to the beginning of the previous word. 2868If BACKWARD is non-nil, jump to the beginning of the previous word.
2962 ;; Returns the new position of point or nil if not found. 2869Returns the new position of point or nil if not found."
2963 (let ((match-cons nil) 2870 (let ((match-cons nil)
2964 (orgpoint (point)) 2871 (orgpoint (point))
2965 (old-syntax (char-to-string (char-syntax ?_)))) 2872 (old-syntax (char-to-string (char-syntax ?_))))
@@ -2987,27 +2894,25 @@ Do not call this function from within a string."
2987 2894
2988 2895
2989(defsubst ada-goto-previous-word () 2896(defsubst ada-goto-previous-word ()
2990 ;; Moves point to the beginning of the previous word of Ada code. 2897 "Moves point to the beginning of the previous word of Ada code.
2991 ;; Returns the new position of point or nil if not found. 2898Returns the new position of point or nil if not found."
2992 (ada-goto-next-word t)) 2899 (ada-goto-next-word t))
2993 2900
2994 2901
2995(defun ada-check-matching-start (keyword) 2902(defun ada-check-matching-start (keyword)
2996 ;; Signals an error if matching block start is not KEYWORD. 2903 "Signals an error if matching block start is not KEYWORD.
2997 ;; Moves point to the matching block start. 2904Moves point to the matching block start."
2998 (ada-goto-matching-start 0) 2905 (ada-goto-matching-start 0)
2999 (unless (looking-at (concat "\\<" keyword "\\>")) 2906 (unless (looking-at (concat "\\<" keyword "\\>"))
3000 (error "matching start is not '%s'" keyword))) 2907 (error "matching start is not '%s'" keyword)))
3001 2908
3002 2909
3003(defun ada-check-defun-name (defun-name) 2910(defun ada-check-defun-name (defun-name)
3004 ;; Checks if the name of the matching defun really is DEFUN-NAME. 2911 "Checks if the name of the matching defun really is DEFUN-NAME.
3005 ;; Assumes point to be already positioned by 'ada-goto-matching-start'. 2912Assumes point to be already positioned by 'ada-goto-matching-start'.
3006 ;; Moves point to the beginning of the declaration. 2913Moves point to the beginning of the declaration."
3007 2914
3008 ;;
3009 ;; named block without a `declare' 2915 ;; named block without a `declare'
3010 ;;
3011 (if (save-excursion 2916 (if (save-excursion
3012 (ada-goto-previous-word) 2917 (ada-goto-previous-word)
3013 (looking-at (concat "\\<" defun-name "\\> *:"))) 2918 (looking-at (concat "\\<" defun-name "\\> *:")))
@@ -3047,9 +2952,9 @@ Do not call this function from within a string."
3047 (buffer-substring (point) 2952 (buffer-substring (point)
3048 (progn (forward-sexp 1) (point)))))))) 2953 (progn (forward-sexp 1) (point))))))))
3049 2954
3050(defun ada-goto-matching-decl-start (&optional noerror nogeneric) 2955(defun ada-goto-matching-decl-start (&optional noerror)
3051 ;; Moves point to the matching declaration start of the current 'begin'. 2956 "Moves point to the matching declaration start of the current 'begin'.
3052 ;; If NOERROR is non-nil, it only returns nil if no match was found. 2957If NOERROR is non-nil, it only returns nil if no match was found."
3053 (let ((nest-count 1) 2958 (let ((nest-count 1)
3054 (first t) 2959 (first t)
3055 (flag nil) 2960 (flag nil)
@@ -3059,13 +2964,12 @@ Do not call this function from within a string."
3059 (if (or 2964 (if (or
3060 (looking-at "\\<\\(package\\|procedure\\|function\\)\\>") 2965 (looking-at "\\<\\(package\\|procedure\\|function\\)\\>")
3061 (save-excursion 2966 (save-excursion
3062 (ada-search-ignore-string-comment "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t) 2967 (ada-search-ignore-string-comment
2968 "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t)
3063 (looking-at "generic"))) 2969 (looking-at "generic")))
3064 (set 'count-generic t)) 2970 (set 'count-generic t))
3065 2971
3066 ;;
3067 ;; search backward for interesting keywords 2972 ;; search backward for interesting keywords
3068 ;;
3069 (while (and 2973 (while (and
3070 (not (zerop nest-count)) 2974 (not (zerop nest-count))
3071 (ada-search-ignore-string-comment ada-matching-decl-start-re t)) 2975 (ada-search-ignore-string-comment ada-matching-decl-start-re t))
@@ -3181,11 +3085,10 @@ Do not call this function from within a string."
3181 )) 3085 ))
3182 3086
3183(defun ada-goto-matching-start (&optional nest-level noerror gotothen) 3087(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
3184 ;; Moves point to the beginning of a block-start. Which block 3088 "Moves point to the beginning of a block-start.
3185 ;; depends on the value of NEST-LEVEL, which defaults to zero. If 3089Which block depends on the value of NEST-LEVEL, which defaults to zero. If
3186 ;; NOERROR is non-nil, it only returns nil if no matching start was 3090NOERROR is non-nil, it only returns nil if no matching start was found.
3187 ;; found. If GOTOTHEN is non-nil, point moves to the 'then' 3091If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
3188 ;; following 'if'.
3189 (let ((nest-count (if nest-level nest-level 0)) 3092 (let ((nest-count (if nest-level nest-level 0))
3190 (found nil) 3093 (found nil)
3191 (pos nil)) 3094 (pos nil))
@@ -3238,8 +3141,10 @@ Do not call this function from within a string."
3238 (if pos 3141 (if pos
3239 (goto-char (car pos)) 3142 (goto-char (car pos))
3240 (error (concat 3143 (error (concat
3241 "No matching 'is' or 'renames' for 'package' at line " 3144 "No matching 'is' or 'renames' for 'package' at"
3242 (number-to-string (count-lines (point-min) (1+ current))))))) 3145 " line "
3146 (number-to-string (count-lines (point-min)
3147 (1+ current)))))))
3243 (unless (looking-at "renames") 3148 (unless (looking-at "renames")
3244 (progn 3149 (progn
3245 (forward-word 1) 3150 (forward-word 1)
@@ -3301,7 +3206,8 @@ Do not call this function from within a string."
3301 gotothen 3206 gotothen
3302 (looking-at "if") 3207 (looking-at "if")
3303 (save-excursion 3208 (save-excursion
3304 (ada-search-ignore-string-comment "then" nil nil nil 'word-search-forward) 3209 (ada-search-ignore-string-comment "then" nil nil nil
3210 'word-search-forward)
3305 (back-to-indentation) 3211 (back-to-indentation)
3306 (looking-at "\\<then\\>"))) 3212 (looking-at "\\<then\\>")))
3307 (goto-char (match-beginning 0))) 3213 (goto-char (match-beginning 0)))
@@ -3309,7 +3215,8 @@ Do not call this function from within a string."
3309 ;; found 'do' => skip back to 'accept' 3215 ;; found 'do' => skip back to 'accept'
3310 ;; 3216 ;;
3311 ((looking-at "do") 3217 ((looking-at "do")
3312 (unless (ada-search-ignore-string-comment "accept" t nil nil 'word-search-backward) 3218 (unless (ada-search-ignore-string-comment "accept" t nil nil
3219 'word-search-backward)
3313 (error "missing 'accept' in front of 'do'")))) 3220 (error "missing 'accept' in front of 'do'"))))
3314 (point)) 3221 (point))
3315 3222
@@ -3319,9 +3226,9 @@ Do not call this function from within a string."
3319 3226
3320 3227
3321(defun ada-goto-matching-end (&optional nest-level noerror) 3228(defun ada-goto-matching-end (&optional nest-level noerror)
3322 ;; Moves point to the end of a block. Which block depends on the 3229 "Moves point to the end of a block.
3323 ;; value of NEST-LEVEL, which defaults to zero. If NOERROR is 3230Which block depends on the value of NEST-LEVEL, which defaults to zero.
3324 ;; non-nil, it only returns nil if found no matching start. 3231If NOERROR is non-nil, it only returns nil if found no matching start."
3325 (let ((nest-count (if nest-level nest-level 0)) 3232 (let ((nest-count (if nest-level nest-level 0))
3326 (found nil)) 3233 (found nil))
3327 3234
@@ -3353,7 +3260,8 @@ Do not call this function from within a string."
3353 (forward-word 1))) 3260 (forward-word 1)))
3354 ;; found package start => check if it really starts a block 3261 ;; found package start => check if it really starts a block
3355 ((looking-at "\\<package\\>") 3262 ((looking-at "\\<package\\>")
3356 (ada-search-ignore-string-comment "is" nil nil nil 'word-search-forward) 3263 (ada-search-ignore-string-comment "is" nil nil nil
3264 'word-search-forward)
3357 (ada-goto-next-non-ws) 3265 (ada-goto-next-non-ws)
3358 ;; ignore and skip it if it is only a 'new' package 3266 ;; ignore and skip it if it is only a 'new' package
3359 (if (looking-at "\\<new\\>") 3267 (if (looking-at "\\<new\\>")
@@ -3378,12 +3286,14 @@ Do not call this function from within a string."
3378 3286
3379(defun ada-search-ignore-string-comment 3287(defun ada-search-ignore-string-comment
3380 (search-re &optional backward limit paramlists search-func ) 3288 (search-re &optional backward limit paramlists search-func )
3381 ;; Regexp-Search for SEARCH-RE, ignoring comments, strings and 3289 "Regexp-search for SEARCH-RE, ignoring comments, strings.
3382 ;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of 3290If PARAMLISTS is nil, ignore parameter lists. Returns a cons cell of
3383 ;; begin and end of match data or nil, if not found. 3291begin and end of match data or nil, if not found.
3384 ;; The search is done using search-func, so that we can choose using 3292The search is done using SEARCH-FUNC, which should search backward if
3385 ;; regular expression search, basic search, ... 3293BACKWARD is non-nil, forward otherwise. SEARCH-FUNC can be optimized in case
3386 ;; Point is moved at the beginning of the search-re 3294we are searching for a constant string.
3295The search stops at pos LIMIT.
3296Point is moved at the beginning of the search-re."
3387 (let (found 3297 (let (found
3388 begin 3298 begin
3389 end 3299 end
@@ -3463,19 +3373,20 @@ Do not call this function from within a string."
3463 (cons begin end) 3373 (cons begin end)
3464 nil))) 3374 nil)))
3465 3375
3466;; ---- boolean functions for indentation 3376;; -------------------------------------------------------
3377;; -- Testing the position of the cursor
3378;; -------------------------------------------------------
3467 3379
3468(defun ada-in-decl-p () 3380(defun ada-in-decl-p ()
3469 ;; Returns t if point is inside a declarative part. 3381 "Returns t if point is inside a declarative part.
3470 ;; Assumes point to be at the end of a statement. 3382Assumes point to be at the end of a statement."
3471 (or 3383 (or (ada-in-paramlist-p)
3472 (ada-in-paramlist-p) 3384 (save-excursion
3473 (save-excursion 3385 (ada-goto-matching-decl-start t))))
3474 (ada-goto-matching-decl-start t))))
3475 3386
3476 3387
3477(defun ada-looking-at-semi-or () 3388(defun ada-looking-at-semi-or ()
3478 ;; Returns t if looking-at an 'or' following a semicolon. 3389 "Returns t if looking-at an 'or' following a semicolon."
3479 (save-excursion 3390 (save-excursion
3480 (and (looking-at "\\<or\\>") 3391 (and (looking-at "\\<or\\>")
3481 (progn 3392 (progn
@@ -3487,7 +3398,7 @@ Do not call this function from within a string."
3487(defun ada-looking-at-semi-private () 3398(defun ada-looking-at-semi-private ()
3488 "Returns t if looking-at an 'private' following a semicolon. 3399 "Returns t if looking-at an 'private' following a semicolon.
3489Returns nil if the private is part of the package name, as in 3400Returns nil if the private is part of the package name, as in
3490'private package A is...' (this can only happen at top level)" 3401'private package A is...' (this can only happen at top level)."
3491 (save-excursion 3402 (save-excursion
3492 (and (looking-at "\\<private\\>") 3403 (and (looking-at "\\<private\\>")
3493 (not (looking-at "\\<private[ \t]*\\(package\\|generic\\)")) 3404 (not (looking-at "\\<private[ \t]*\\(package\\|generic\\)"))
@@ -3502,21 +3413,20 @@ Returns nil if the private is part of the package name, as in
3502 3413
3503(defsubst ada-in-string-p (&optional parse-result) 3414(defsubst ada-in-string-p (&optional parse-result)
3504 "Returns t if point is inside a string. 3415 "Returns t if point is inside a string.
3505if parse-result is non-nil, use is instead of calling parse-partial-sexp" 3416If parse-result is non-nil, use is instead of calling parse-partial-sexp."
3506 (nth 3 (or parse-result 3417 (nth 3 (or parse-result
3507 (parse-partial-sexp 3418 (parse-partial-sexp
3508 (save-excursion (beginning-of-line) (point)) (point))))) 3419 (save-excursion (beginning-of-line) (point)) (point)))))
3509 3420
3510(defsubst ada-in-string-or-comment-p (&optional parse-result) 3421(defsubst ada-in-string-or-comment-p (&optional parse-result)
3511 "Returns t if inside a comment or string" 3422 "Returns t if inside a comment or string."
3512 (set 'parse-result (or parse-result 3423 (set 'parse-result (or parse-result
3513 (parse-partial-sexp 3424 (parse-partial-sexp
3514 (save-excursion (beginning-of-line) (point)) (point)))) 3425 (save-excursion (beginning-of-line) (point)) (point))))
3515 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result))) 3426 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
3516 3427
3517(defun ada-in-paramlist-p () 3428(defun ada-in-paramlist-p ()
3518 ;; Returns t if point is inside a parameter-list 3429 "Returns t if point is inside a parameter-list."
3519 ;; following 'function'/'procedure'/'package'.
3520 (save-excursion 3430 (save-excursion
3521 (and 3431 (and
3522 (re-search-backward "(\\|)" nil t) 3432 (re-search-backward "(\\|)" nil t)
@@ -3543,15 +3453,15 @@ if parse-result is non-nil, use is instead of calling parse-partial-sexp"
3543 "pragma\\|" 3453 "pragma\\|"
3544 "type\\)\\>")))))) 3454 "type\\)\\>"))))))
3545 3455
3546;; not really a boolean function ...
3547(defun ada-in-open-paren-p () 3456(defun ada-in-open-paren-p ()
3548 "If point is somewhere behind an open parenthesis not yet closed, 3457 "Returns the position of the first non-ws behind the last unclosed
3549it returns the position of the first non-ws behind that open parenthesis, 3458parenthesis, or nil."
3550otherwise nil"
3551 (save-excursion 3459 (save-excursion
3552 (let ((parse (parse-partial-sexp 3460 (let ((parse (parse-partial-sexp
3553 (point) 3461 (point)
3554 (or (car (ada-search-ignore-string-comment "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>" t)) 3462 (or (car (ada-search-ignore-string-comment
3463 "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>"
3464 t))
3555 (point-min))))) 3465 (point-min)))))
3556 3466
3557 (if (nth 1 parse) 3467 (if (nth 1 parse)
@@ -3561,14 +3471,14 @@ otherwise nil"
3561 (point)))))) 3471 (point))))))
3562 3472
3563 3473
3564;;;----------------------;;; 3474;;;-----------------------------------------------------------
3565;;; Behaviour Of TAB Key ;;; 3475;;; Behavior Of TAB Key
3566;;;----------------------;;; 3476;;;-----------------------------------------------------------
3477
3567(defun ada-tab () 3478(defun ada-tab ()
3568 "Do indenting or tabbing according to `ada-tab-policy'. 3479 "Do indenting or tabbing according to `ada-tab-policy'.
3569
3570In Transient Mark mode, if the mark is active, operate on the contents 3480In Transient Mark mode, if the mark is active, operate on the contents
3571of the region. Otherwise, operates only on the current line" 3481of the region. Otherwise, operates only on the current line."
3572 (interactive) 3482 (interactive)
3573 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard)) 3483 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
3574 ((eq ada-tab-policy 'indent-auto) 3484 ((eq ada-tab-policy 'indent-auto)
@@ -3619,12 +3529,12 @@ of the region. Otherwise, operates only on the current line"
3619 3529
3620 3530
3621 3531
3622;;;---------------;;; 3532;; ------------------------------------------------------------
3623;;; Miscellaneous ;;; 3533;; -- Miscellaneous
3624;;;---------------;;; 3534;; ------------------------------------------------------------
3625 3535
3626(defun ada-remove-trailing-spaces () 3536(defun ada-remove-trailing-spaces ()
3627 "remove trailing spaces in the whole buffer." 3537 "Remove trailing spaces in the whole buffer."
3628 (interactive) 3538 (interactive)
3629 (save-match-data 3539 (save-match-data
3630 (save-excursion 3540 (save-excursion
@@ -3634,15 +3544,12 @@ of the region. Otherwise, operates only on the current line"
3634 (while (re-search-forward "[ \t]+$" (point-max) t) 3544 (while (re-search-forward "[ \t]+$" (point-max) t)
3635 (replace-match "" nil nil)))))) 3545 (replace-match "" nil nil))))))
3636 3546
3637
3638;; define a function to support find-file.el if loaded
3639(defun ada-ff-other-window () 3547(defun ada-ff-other-window ()
3640 "Find other file in other window using `ff-find-other-file'." 3548 "Find other file in other window using `ff-find-other-file'."
3641 (interactive) 3549 (interactive)
3642 (and (fboundp 'ff-find-other-file) 3550 (and (fboundp 'ff-find-other-file)
3643 (ff-find-other-file t))) 3551 (ff-find-other-file t)))
3644 3552
3645;; inspired by Laurent.GUERBY@enst-bretagne.fr
3646(defun ada-gnat-style () 3553(defun ada-gnat-style ()
3647 "Clean up comments, `(' and `,' for GNAT style checking switch." 3554 "Clean up comments, `(' and `,' for GNAT style checking switch."
3648 (interactive) 3555 (interactive)
@@ -3660,9 +3567,10 @@ of the region. Otherwise, operates only on the current line"
3660 3567
3661 3568
3662 3569
3663;;;-------------------------------;;; 3570;; -------------------------------------------------------------
3664;;; Moving To Procedures/Packages ;;; 3571;; -- Moving To Procedures/Packages
3665;;;-------------------------------;;; 3572;; -------------------------------------------------------------
3573
3666(defun ada-next-procedure () 3574(defun ada-next-procedure ()
3667 "Moves point to next procedure." 3575 "Moves point to next procedure."
3668 (interactive) 3576 (interactive)
@@ -3696,12 +3604,12 @@ of the region. Otherwise, operates only on the current line"
3696 (error "No more packages"))) 3604 (error "No more packages")))
3697 3605
3698 3606
3699;;;----------------------- 3607;; ------------------------------------------------------------
3700;;; define keymap and menus for Ada 3608;; -- Define keymap and menus for Ada
3701;;;----------------------- 3609;; -------------------------------------------------------------
3702 3610
3703(defun ada-create-keymap () 3611(defun ada-create-keymap ()
3704 "Create the keymap associated with the Ada mode" 3612 "Create the keymap associated with the Ada mode."
3705 3613
3706 ;; Indentation and Formatting 3614 ;; Indentation and Formatting
3707 (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional) 3615 (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional)
@@ -3735,16 +3643,16 @@ of the region. Otherwise, operates only on the current line"
3735 ;; Make body 3643 ;; Make body
3736 (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body) 3644 (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body)
3737 3645
3738 ;; Use predefined function of emacs19 for comments (RE) 3646 ;; Use predefined function of Emacs19 for comments (RE)
3739 (define-key ada-mode-map "\C-c;" 'comment-region) 3647 (define-key ada-mode-map "\C-c;" 'comment-region)
3740 (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) 3648 (define-key ada-mode-map "\C-c:" 'ada-uncomment-region)
3741
3742 ) 3649 )
3743 3650
3651
3744(defun ada-create-menu () 3652(defun ada-create-menu ()
3745 "Create the ada menu as shown in the menu bar. 3653 "Create the ada menu as shown in the menu bar.
3746This function is designed to be extensible, so that each compiler-specific file 3654This function is designed to be extensible, so that each compiler-specific file
3747can add its own items" 3655can add its own items."
3748 3656
3749 ;; Note that the separators must have different length in the submenus 3657 ;; Note that the separators must have different length in the submenus
3750 (autoload 'easy-menu-define "easymenu") 3658 (autoload 'easy-menu-define "easymenu")
@@ -3800,14 +3708,17 @@ can add its own items"
3800 ) 3708 )
3801 3709
3802 3710
3803 3711;; -------------------------------------------------------
3804 3712;; Commenting/Uncommenting code
3805;;
3806;; The two following calls are provided to enhance the standard 3713;; The two following calls are provided to enhance the standard
3807;; comment-region function, which only allows uncommenting if the 3714;; comment-region function, which only allows uncommenting if the
3808;; comment is at the beginning of a line. If the line have been reindented, 3715;; comment is at the beginning of a line. If the line have been re-indented,
3809;; we are unable to use comment-region, which makes no sense. 3716;; we are unable to use comment-region, which makes no sense.
3810;; 3717;;
3718;; In addition, we provide an interface to the standard comment handling
3719;; function for justifying the comments.
3720;; -------------------------------------------------------
3721
3811(defadvice comment-region (before ada-uncomment-anywhere) 3722(defadvice comment-region (before ada-uncomment-anywhere)
3812 (if (and arg 3723 (if (and arg
3813 (< arg 0) 3724 (< arg 0)
@@ -3819,12 +3730,8 @@ can add its own items"
3819 (replace-match comment-start)) 3730 (replace-match comment-start))
3820 )))) 3731 ))))
3821 3732
3822;;
3823;; Handling of comments
3824;;
3825
3826(defun ada-uncomment-region (beg end &optional arg) 3733(defun ada-uncomment-region (beg end &optional arg)
3827 "delete `comment-start' at the beginning of a line in the region." 3734 "Delete `comment-start' at the beginning of a line in the region."
3828 (interactive "r\nP") 3735 (interactive "r\nP")
3829 (ad-activate 'comment-region) 3736 (ad-activate 'comment-region)
3830 (comment-region beg end (- (or arg 1))) 3737 (comment-region beg end (- (or arg 1)))
@@ -3837,7 +3744,7 @@ can add its own items"
3837 3744
3838(defun ada-fill-comment-paragraph-postfix () 3745(defun ada-fill-comment-paragraph-postfix ()
3839 "Fills current comment paragraph and justifies each line as well. 3746 "Fills current comment paragraph and justifies each line as well.
3840Adds `ada-fill-comment-postfix' at the end of each line" 3747Adds `ada-fill-comment-postfix' at the end of each line."
3841 (interactive) 3748 (interactive)
3842 (ada-fill-comment-paragraph 'full t)) 3749 (ada-fill-comment-paragraph 'full t))
3843 3750
@@ -3931,15 +3838,23 @@ The paragraph is indented on the first line."
3931 3838
3932 (goto-char opos))) 3839 (goto-char opos)))
3933 3840
3934;;;--------------------------------------------------- 3841;; ---------------------------------------------------
3935;;; support for find-file.el 3842;; support for find-file.el
3936;;;--------------------------------------------------- 3843;; These functions are used by find-file to guess the file names from
3937 3844;; unit names, and to find the other file (spec or body) from the current
3938;;; Note : this function is overwritten when we work with GNAT: we then 3845;; file (body or spec).
3939;;; use gnatkrunch 3846;; It is also used to find in which function we are, so as to put the
3847;; cursor at the correct position.
3848;; Standard Ada does not force any relation between unit names and file names,
3849;; so some of these functions can only be a good approximation. However, they
3850;; are also overriden in `ada-xref'.el when we know that the user is using
3851;; GNAT.
3852;; ---------------------------------------------------
3853
3854;; Overriden when we work with GNAT, to use gnatkrunch
3940(defun ada-make-filename-from-adaname (adaname) 3855(defun ada-make-filename-from-adaname (adaname)
3941 "Determine the filename of a package/procedure from its own Ada name. 3856 "Determine the filename in which ADANAME is found.
3942This is a generic function, independant from any compiler." 3857This is a generic function, independent from any compiler."
3943 (while (string-match "\\." adaname) 3858 (while (string-match "\\." adaname)
3944 (set 'adaname (replace-match "-" t t adaname))) 3859 (set 'adaname (replace-match "-" t t adaname)))
3945 adaname 3860 adaname
@@ -3951,52 +3866,53 @@ or the spec otherwise."
3951 (let ((ff-always-try-to-create nil) 3866 (let ((ff-always-try-to-create nil)
3952 (buffer (current-buffer)) 3867 (buffer (current-buffer))
3953 name) 3868 name)
3954 (ff-find-other-file nil t);; same window, ignore 'with' lines 3869 (ff-find-other-file nil t) ;; same window, ignore 'with' lines
3955 (if (equal buffer (current-buffer))
3956 3870
3957 ;; other file not found 3871 ;; If the other file was not found, return an empty string
3872 (if (equal buffer (current-buffer))
3958 "" 3873 ""
3959
3960 ;; other file found
3961 (set 'name (buffer-file-name)) 3874 (set 'name (buffer-file-name))
3962 (switch-to-buffer buffer) 3875 (switch-to-buffer buffer)
3963 name))) 3876 name)))
3964 3877
3965;;; functions for placing the cursor on the corresponding subprogram
3966(defun ada-which-function-are-we-in () 3878(defun ada-which-function-are-we-in ()
3967 "Determine whether we are on a function definition/declaration. 3879 "Return the name of the function whose definition/declaration point is in.
3968If that is the case remember the name of that function. 3880Redefines the function `ff-which-function-are-we-in'."
3969This function is used in support of the find-file.el package"
3970
3971 (set 'ff-function-name nil) 3881 (set 'ff-function-name nil)
3972 (save-excursion 3882 (save-excursion
3973 (end-of-line);; make sure we get the complete name 3883 (end-of-line) ;; make sure we get the complete name
3974 (if (or (re-search-backward ada-procedure-start-regexp nil t) 3884 (if (or (re-search-backward ada-procedure-start-regexp nil t)
3975 (re-search-backward ada-package-start-regexp nil t)) 3885 (re-search-backward ada-package-start-regexp nil t))
3976 (set 'ff-function-name (match-string 0))) 3886 (set 'ff-function-name (match-string 0)))
3977 )) 3887 ))
3978 3888
3979(defun ada-set-point-accordingly () 3889(defun ada-set-point-accordingly ()
3980 "Move to the function declaration that was set by `ff-which-function-are-we-in'" 3890 "Move to the function declaration that was set by
3891`ff-which-function-are-we-in'."
3981 (if ff-function-name 3892 (if ff-function-name
3982 (progn 3893 (progn
3983 (goto-char (point-min)) 3894 (goto-char (point-min))
3984 (unless (ada-search-ignore-string-comment (concat ff-function-name "\\b") nil) 3895 (unless (ada-search-ignore-string-comment
3896 (concat ff-function-name "\\b") nil)
3985 (goto-char (point-min)))))) 3897 (goto-char (point-min))))))
3986 3898
3987;;;--------------------------------------------------- 3899
3988;;; support for font-lock 3900;; ---------------------------------------------------
3989;;;--------------------------------------------------- 3901;; support for font-lock.el
3990;; Strings are a real pain in Ada because a single quote character is 3902;; Strings are a real pain in Ada because a single quote character is
3991;; overloaded as a string quote and type/instance delimiter. By default, a 3903;; overloaded as a string quote and type/instance delimiter. By default, a
3992;; single quote is given punctuation syntax in `ada-mode-syntax-table'. 3904;; single quote is given punctuation syntax in `ada-mode-syntax-table'.
3993;; So, for Font Lock mode purposes, we mark single quotes as having string 3905;; So, for Font Lock mode purposes, we mark single quotes as having string
3994;; syntax when the gods that created Ada determine them to be. sm. 3906;; syntax when the gods that created Ada determine them to be.
3907;;
3908;; This only works in Emacs. See the comments before the grammar functions
3909;; at the beginning of this file for how this is done with XEmacs.
3910;; ----------------------------------------------------
3995 3911
3996(defconst ada-font-lock-syntactic-keywords 3912(defconst ada-font-lock-syntactic-keywords
3997 ;; Mark single quotes as having string quote syntax in 'c' instances. 3913 ;; Mark single quotes as having string quote syntax in 'c' instances.
3998 ;; As a special case, ''' will not be hilighted, but if we do not 3914 ;; As a special case, ''' will not be highlighted, but if we do not
3999 ;; set this special case, then the rest of the buffer is hilighted as 3915 ;; set this special case, then the rest of the buffer is highlighted as
4000 ;; a string 3916 ;; a string
4001 ;; This sets the properties of the characters, so that ada-in-string-p 3917 ;; This sets the properties of the characters, so that ada-in-string-p
4002 ;; correctly handles '"' too... 3918 ;; correctly handles '"' too...
@@ -4080,25 +3996,32 @@ This function is used in support of the find-file.el package"
4080 )) 3996 ))
4081 "Default expressions to highlight in Ada mode.") 3997 "Default expressions to highlight in Ada mode.")
4082 3998
4083;; 3999;; ---------------------------------------------------------
4084;; outline-minor-mode support 4000;; Support for outline.el
4001;; ---------------------------------------------------------
4085 4002
4086(defun ada-outline-level () 4003(defun ada-outline-level ()
4087 ;; This is so that `current-column` DTRT in otherwise-hidden text 4004 "This is so that `current-column` DTRT in otherwise-hidden text"
4088 ;; patch from Dave Love <fx@gnu.org> 4005 ;; patch from Dave Love <fx@gnu.org>
4089 (let (buffer-invisibility-spec) 4006 (let (buffer-invisibility-spec)
4090 (save-excursion 4007 (save-excursion
4091 (back-to-indentation) 4008 (back-to-indentation)
4092 (current-column)))) 4009 (current-column))))
4093 4010
4094;; 4011;; ---------------------------------------------------------
4095;; Body generation 4012;; Automatic generation of code
4096;; 4013;; The Ada-mode has a set of function to automatically generate a subprogram
4014;; or package body from its spec.
4015;; These function only use a primary and basic algorithm, this could use a
4016;; lot of improvement.
4017;; When the user is using GNAT, we rather use gnatstub to generate an accurate
4018;; body.
4019;; ----------------------------------------------------------
4097 4020
4098(defun ada-gen-treat-proc (match) 4021(defun ada-gen-treat-proc (match)
4099 ;; make dummy body of a procedure/function specification. 4022 "Make dummy body of a procedure/function specification.
4100 ;; MATCH is a cons cell containing the start and end location of the 4023MATCH is a cons cell containing the start and end location of the last search
4101 ;; last search for ada-procedure-start-regexp. 4024for ada-procedure-start-regexp."
4102 (goto-char (car match)) 4025 (goto-char (car match))
4103 (let (func-found procname functype) 4026 (let (func-found procname functype)
4104 (cond 4027 (cond
@@ -4169,7 +4092,6 @@ This function is used in support of the find-file.el package"
4169 "Create an Ada package body in the current buffer. 4092 "Create an Ada package body in the current buffer.
4170The potential old buffer contents is deleted first, then we copy the 4093The potential old buffer contents is deleted first, then we copy the
4171spec buffer in here and modify it to make it a body. 4094spec buffer in here and modify it to make it a body.
4172
4173This function typically is to be hooked into `ff-file-created-hooks'." 4095This function typically is to be hooked into `ff-file-created-hooks'."
4174 (interactive) 4096 (interactive)
4175 (delete-region (point-min) (point-max)) 4097 (delete-region (point-min) (point-max))
@@ -4200,7 +4122,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
4200 (ada-gen-treat-proc found)))))) 4122 (ada-gen-treat-proc found))))))
4201 4123
4202(defun ada-make-subprogram-body () 4124(defun ada-make-subprogram-body ()
4203 "make one dummy subprogram body from spec surrounding point" 4125 "Make one dummy subprogram body from spec surrounding point."
4204 (interactive) 4126 (interactive)
4205 (let* ((found (re-search-backward ada-procedure-start-regexp nil t)) 4127 (let* ((found (re-search-backward ada-procedure-start-regexp nil t))
4206 (spec (match-beginning 0))) 4128 (spec (match-beginning 0)))
@@ -4243,6 +4165,10 @@ This function typically is to be hooked into `ff-file-created-hooks'."
4243 )) 4165 ))
4244 (error "Not in subprogram spec")))) 4166 (error "Not in subprogram spec"))))
4245 4167
4168;; --------------------------------------------------------
4169;; Global initializations
4170;; --------------------------------------------------------
4171
4246;; Create the keymap once and for all. If we do that in ada-mode, 4172;; Create the keymap once and for all. If we do that in ada-mode,
4247;; the keys changed in the user's .emacs have to be modified 4173;; the keys changed in the user's .emacs have to be modified
4248;; every time 4174;; every time
@@ -4276,4 +4202,3 @@ This function typically is to be hooked into `ff-file-created-hooks'."
4276(provide 'ada-mode) 4202(provide 'ada-mode)
4277 4203
4278;;; ada-mode.el ends here 4204;;; ada-mode.el ends here
4279