diff options
| author | Gerd Moellmann | 1999-10-28 11:00:34 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 1999-10-28 11:00:34 +0000 |
| commit | 655880d250fed4339ea4320c66e32828e493d0ee (patch) | |
| tree | 2fc99e0f163338ec4391081ba73a66481f3f18eb | |
| parent | 400c12fd9831fa06739ecd3e24b68d051d9c138c (diff) | |
| download | emacs-655880d250fed4339ea4320c66e32828e493d0ee.tar.gz emacs-655880d250fed4339ea4320c66e32828e493d0ee.zip | |
Changed format of years in copyright notice.
| -rw-r--r-- | lisp/progmodes/ada-mode.el | 1153 |
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. |
| 109 | if IS_XEMACS is non-nil, check for XEmacs instead of Emacs" | 109 | If 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. | |||
| 138 | This is a good place to add Ada environment specific bindings.") | 138 | This 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. |
| 179 | exceptions for identifiers. | ||
| 180 | This file should contain one word per line, that gives the casing | 179 | This file should contain one word per line, that gives the casing |
| 181 | to be used for that words in Ada files" | 180 | to 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. |
| 186 | It may be `downcase-word', `upcase-word', `ada-loose-case-word' or | 185 | It 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. |
| 239 | If ada-indent-return is null or negative, the indentation is done relative to | 238 | If ada-indent-return is null or negative, the indentation is done relative to |
| 240 | the open parenthesis (if there is no parenthesis, ada-broken-indent is used) | 239 | the open parenthesis (if there is no parenthesis, ada-broken-indent is used). |
| 241 | 240 | ||
| 242 | An example is: | 241 | An 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, |
| 277 | not to 'begin'." | 276 | not 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. |
| 282 | if nil, no contextual menu is available") | 281 | If 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. |
| 288 | for the `ff-search-directories' variable. | 287 | See the description for the `ff-search-directories' variable. |
| 289 | Emacs will automatically add the paths defined in your project file." | 288 | Emacs will automatically add the paths defined in your project file, and if you |
| 289 | are using the GNAT compiler the output of the gnatls command to find where the | ||
| 290 | runtime 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 | ||
| 298 | An example is: | 299 | An 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. |
| 305 | This is used only in the ada-tab and ada-untab functions. | ||
| 306 | Must be one of : | 306 | Must 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 | ||
| 318 | An example is: | 318 | An 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. |
| 325 | made available through the ada-mode. The possible choices are : | 325 | This will determine what features are made available through the ada-mode. |
| 326 | 326 | The 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. |
| 340 | include a `.' if needed") | 340 | The 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. |
| 344 | include a `.' if needed") | 344 | The 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. |
| 369 | ada-83-keywords and ada-95-keywords")) | 369 | This 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.") |
| 376 | be reindented according to the function `ada-case-identifier'. | ||
| 377 | Its 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. |
| 384 | See `ff-other-file-alist'" | 382 | See `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. | ||
| 478 | The variable `ada-contextual-menu-on-identifier' will be set to t before | ||
| 479 | displaying 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. |
| 496 | This variable will create two submenus, one for type and subtype definitions, | 533 | See `imenu-generic-expression'. This variable will create two submenus, one |
| 497 | the other for subprograms declarations. The main menu will reference the bodies | 534 | for type and subtype definitions, the other for subprograms declarations. |
| 498 | of the subprograms.") | 535 | The 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. |
| 515 | location, go to this position. It adds to compile.el the capacity to go to a | 551 | If POS is on a file and line location, go to this position. It adds to |
| 516 | reference in an error message. | 552 | compile.el the capacity to go to a reference in an error message. |
| 517 | For instance, on this line: | 553 | For 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 |
| 519 | both file locations can be clicked on and jumped to" | 555 | both 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 | 617 | The standard table declares `_' as a symbol constituent, the second one |
| 556 | ;; `_' as a symbol constituant, in the second one, it is a word | 618 | declares 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. |
| 671 | a duplicate of font-lock" | 707 | This 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. |
| 676 | In particular, character constants that contain string delimiters are said | 712 | In particular, character constants are said to be strings, #...# are treated |
| 677 | to be strings. | 713 | as numbers instead of gnatprep comments." |
| 678 | We 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 | 736 | OLD-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. |
| 764 | POSITION 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. |
| 777 | The addition is done so that `goto-other-file' works as expected" | 791 | Going from body to spec with `ff-find-other-file' used these |
| 778 | 792 | extensions. | |
| 793 | SPEC and BODY are two regular expressions that must match against the file | ||
| 794 | name" | ||
| 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. |
| 1058 | is not given, then the current word in the buffer is used instead. | 1081 | If WORD is not given, then the current word in the buffer is used instead. |
| 1059 | Every time the ada-mode will see the same word, the same casing will | 1082 | The new words is added to the first file in `ada-case-exception-file'. |
| 1060 | be used. | 1083 | The standard casing rules will no longer apply to this word." |
| 1061 | The 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." |
| 1122 | have 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. |
| 1144 | done according to the value of `ada-case-identifier' and the | 1165 | The auto-casing is done according to the value of `ada-case-identifier' and |
| 1145 | exceptions defined in `ada-case-exception'" | 1166 | the 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. |
| 1176 | Respect options `ada-case-keyword', `ada-case-identifier', and | 1196 | If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." |
| 1177 | `ada-case-attribute'. | ||
| 1178 | If 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. | ||
| 1234 | ARG 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. |
| 1262 | word. Ignores Arg (its there to conform to capitalize-word parameters) | 1280 | No other letter is modified. |
| 1263 | Does not change other letters" | 1281 | ARG 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. |
| 1278 | lower case other letters" | 1296 | ARG 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. |
| 1293 | Attention: This function might take very long for big regions !" | 1307 | Attention: 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. |
| 1343 | ATTENTION: This function might take very long for big buffers !" | 1353 | ATTENTION: 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 |
| 1353 | ATTENTION: 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 | ;; ... ) |
| 1356 | In 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. | 1421 | Returns 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. |
| 1855 | insert a newline and indents the newline. | 1802 | The original line is indented first if `ada-indent-after-return' is non-nil. |
| 1856 | If `ada-indent-after-return' is nil then inserts a newline and indents the | 1803 | This function is intended to be bound to the \C-m and \C-j keys." |
| 1857 | newline. | ||
| 1858 | This 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. |
| 1890 | Each of these steps returns a two element list: | 1835 | Returns the calculation that was done, including the reference point and the |
| 1891 | - position of reference in the buffer | 1836 | offset." |
| 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 | |||
| 1961 | Returns 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. |
| 2234 | in the buffer. This function does not pay any attention to the current line, | 2169 | The result list is based on the previous lines in the buffer. |
| 2235 | since this is the role of the second step in the indentation | 2170 | If NOMOVE is nil, moves point to the beginning of the current statement. |
| 2236 | (see ada-get-current-indent). | 2171 | if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation." |
| 2237 | |||
| 2238 | Returns 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) | ||
| 2242 | Moves 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 | ||
| 2314 | behind 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." |
| 2327 | after ORGPOINT. | ||
| 2328 | Assumes 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. | 2273 | ORGPOINT 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. | 2340 | ORGPOINT 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. | 2383 | ORGPOINT 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. | 2391 | ORGPOINT 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 | 2421 | ORGPOINT 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. | 2437 | ORGPOINT 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'. | 2507 | ORGPOINT 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. | 2553 | ORGPOINT 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. |
| 2680 | Assumes point to be at the beginning of a loop statement | 2585 | ORGPOINT is the limit position used in the calculation." |
| 2681 | or 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. | 2694 | ORGPOINT 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 | 2749 | Returns the new position of point. |
| 2839 | ;; by searching for 'ada-end-stmt-re' and then moving to the | 2750 | As 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 | 2751 | open 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. | 2796 | Returns 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 | 2797 | match." |
| 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. |
| 2934 | character. Signals an error if there is no more such character | 2841 | Stop the search at LIMIT. |
| 2935 | and limit is nil. | ||
| 2936 | Do not call this function from within a string." | 2842 | Do 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. | 2859 | Returns the new position of point or nil if not found. |
| 2860 | Stop 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. | 2868 | If BACKWARD is non-nil, jump to the beginning of the previous word. |
| 2962 | ;; Returns the new position of point or nil if not found. | 2869 | Returns 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. | 2898 | Returns 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. | 2904 | Moves 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'. | 2912 | Assumes point to be already positioned by 'ada-goto-matching-start'. |
| 3006 | ;; Moves point to the beginning of the declaration. | 2913 | Moves 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. | 2957 | If 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 | 3089 | Which 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 | 3090 | NOERROR 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' | 3091 | If 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 | 3230 | Which block depends on the value of NEST-LEVEL, which defaults to zero. |
| 3324 | ;; non-nil, it only returns nil if found no matching start. | 3231 | If 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 | 3290 | If PARAMLISTS is nil, ignore parameter lists. Returns a cons cell of |
| 3383 | ;; begin and end of match data or nil, if not found. | 3291 | begin and end of match data or nil, if not found. |
| 3384 | ;; The search is done using search-func, so that we can choose using | 3292 | The search is done using SEARCH-FUNC, which should search backward if |
| 3385 | ;; regular expression search, basic search, ... | 3293 | BACKWARD is non-nil, forward otherwise. SEARCH-FUNC can be optimized in case |
| 3386 | ;; Point is moved at the beginning of the search-re | 3294 | we are searching for a constant string. |
| 3295 | The search stops at pos LIMIT. | ||
| 3296 | Point 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. | 3382 | Assumes 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. |
| 3489 | Returns nil if the private is part of the package name, as in | 3400 | Returns 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. |
| 3505 | if parse-result is non-nil, use is instead of calling parse-partial-sexp" | 3416 | If 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 |
| 3549 | it returns the position of the first non-ws behind that open parenthesis, | 3458 | parenthesis, or nil." |
| 3550 | otherwise 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 | |||
| 3570 | In Transient Mark mode, if the mark is active, operate on the contents | 3480 | In Transient Mark mode, if the mark is active, operate on the contents |
| 3571 | of the region. Otherwise, operates only on the current line" | 3481 | of 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. |
| 3746 | This function is designed to be extensible, so that each compiler-specific file | 3654 | This function is designed to be extensible, so that each compiler-specific file |
| 3747 | can add its own items" | 3655 | can 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. |
| 3840 | Adds `ada-fill-comment-postfix' at the end of each line" | 3747 | Adds `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. |
| 3942 | This is a generic function, independant from any compiler." | 3857 | This 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. |
| 3968 | If that is the case remember the name of that function. | 3880 | Redefines the function `ff-which-function-are-we-in'." |
| 3969 | This 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 | 4023 | MATCH is a cons cell containing the start and end location of the last search |
| 4101 | ;; last search for ada-procedure-start-regexp. | 4024 | for 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. |
| 4170 | The potential old buffer contents is deleted first, then we copy the | 4093 | The potential old buffer contents is deleted first, then we copy the |
| 4171 | spec buffer in here and modify it to make it a body. | 4094 | spec buffer in here and modify it to make it a body. |
| 4172 | |||
| 4173 | This function typically is to be hooked into `ff-file-created-hooks'." | 4095 | This 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 | |||