[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master a13c642: Delete built-in ada-mode; Gnu ELPA is a go
|
From: |
Stephen Leake |
|
Subject: |
[Emacs-diffs] master a13c642: Delete built-in ada-mode; Gnu ELPA is a good replacement |
|
Date: |
Tue, 20 Aug 2019 18:36:24 -0400 (EDT) |
branch: master
commit a13c64204c8ead966789abf8efe176e4f2d4f599
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
Delete built-in ada-mode; Gnu ELPA is a good replacement
* doc/misc/Makefile.in (INFO_COMMON): Delete ada-mode.
* doc/misc/ada-mode.texi: Delete.
* etc/NEWS: Mention ada-mode deleted.
* lisp/progmodes/ada-mode.el: Delete.
* lisp/progmodes/ada-prj.el: Delete.
* lisp/progmodes/ada-stmt.el: Delete.
* lisp/progmodes/ada-xref.el: Delete.
---
doc/misc/Makefile.in | 2 +-
doc/misc/ada-mode.texi | 1526 ------------
etc/NEWS | 5 +
lisp/progmodes/ada-mode.el | 5493 --------------------------------------------
lisp/progmodes/ada-prj.el | 682 ------
lisp/progmodes/ada-stmt.el | 486 ----
lisp/progmodes/ada-xref.el | 2359 -------------------
7 files changed, 6 insertions(+), 10547 deletions(-)
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index a03efaf..5490580 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -65,7 +65,7 @@ MAKEINFO_OPTS = --force -I$(emacsdir)
DOCMISC_W32 = @DOCMISC_W32@
## Info files to build and install on all platforms.
-INFO_COMMON = ada-mode auth autotype bovine calc ccmode cl \
+INFO_COMMON = auth autotype bovine calc ccmode cl \
dbus dired-x ebrowse ede ediff edt eieio \
emacs-mime epa erc ert eshell eudc efaq eww \
flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \
diff --git a/doc/misc/ada-mode.texi b/doc/misc/ada-mode.texi
deleted file mode 100644
index 1ac90cd..0000000
--- a/doc/misc/ada-mode.texi
+++ /dev/null
@@ -1,1526 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@setfilename ../../info/ada-mode.info
-@settitle Ada Mode
-@include docstyle.texi
-
-@copying
-Copyright @copyright{} 1999--2019 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover Texts being ``A GNU Manual'',
-and with the Back-Cover Texts as in (a) below. A copy of the license
-is included in the section entitled ``GNU Free Documentation License''.
-
-(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
-modify this GNU manual.''
-@end quotation
-@end copying
-
-@dircategory Emacs editing modes
-@direntry
-* Ada mode: (ada-mode). Emacs mode for editing and compiling Ada code.
-@end direntry
-
-@titlepage
-@sp 10
-@title Ada Mode
-@sp 2
-@subtitle An Emacs major mode for programming in Ada
-@subtitle Ada Mode Version 4.00
-@sp 2
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@contents
-
-@node Top
-@top Ada Mode
-
-@ifnottex
-@insertcopying
-@end ifnottex
-
-@menu
-* Overview::
-* Installation:: Installing Ada mode on your system
-* Customization:: Setting up Ada mode to your taste
-* Compiling Executing:: Working with your application within Emacs
-* Project files:: Describing the organization of your project
-* Compiling Examples:: A small tutorial
-* Moving Through Ada Code:: Moving easily through Ada sources
-* Identifier completion:: Finishing words automatically
-* Automatic Smart Indentation:: Indenting your code automatically as you type
-* Formatting Parameter Lists:: Formatting subprograms' parameter lists
- automatically
-* Automatic Casing:: Adjusting the case of words automatically
-* Statement Templates:: Inserting code templates
-* Comment Handling:: Reformatting comments easily
-* GNU Free Documentation License:: The license for this documentation.
-* Index::
-@end menu
-
-
-@node Overview
-@chapter Overview
-
-The Emacs mode for programming in Ada helps the user in understanding
-existing code and facilitates writing new code.
-
-When the GNU Ada compiler GNAT is used, the cross-reference
-information output by the compiler is used to provide powerful code
-navigation (jump to definition, find all uses, etc.).
-
-When you open a file with a file extension of @file{.ads} or
-@file{.adb}, Emacs will automatically load and activate Ada mode.
-
-Ada mode works without any customization, if you are using the GNAT
-compiler (@url{https://libre2.adacore.com/}) and the GNAT default
-naming convention.
-
-You must customize a few things if you are using a different compiler
-or file naming convention; @xref{Other compiler}, @xref{Non-standard
-file names}.
-
-In addition, you may want to customize the indentation,
-capitalization, and other things; @xref{Other customization}.
-
-Finally, for large Ada projects, you will want to set up an Emacs
-Ada mode project file for each project; @xref{Project files}. Note
-that these are different from the GNAT project files used by gnatmake
-and other GNAT commands.
-
-See the Emacs info manual, section 'Running Debuggers Under Emacs',
-for general information on debugging.
-
-@node Installation
-@chapter Installation
-
-Ada mode is part of the standard Emacs distribution; if you use that,
-no files need to be installed.
-
-Ada mode is also available as a separate distribution, from the Emacs
-Ada mode website
-@uref{http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html}. The
-separate distribution may be more recent.
-
-For installing the separate distribution, see the @file{README} file
-in the distribution.
-
-To see what version of Ada mode you have installed, do @kbd{M-x
-ada-mode-version}.
-
-The following files are provided with the Ada mode distribution:
-
-@itemize @bullet
-
-@item
-@file{ada-mode.el}: The main file for Ada mode, providing indentation,
-formatting of parameter lists, moving through code, comment handling
-and automatic casing.
-
-@item
-@file{ada-prj.el}: GUI editing of Ada mode project files, using Emacs
-widgets.
-
-@item
-@file{ada-stmt.el}: Ada statement templates.
-
-@item
-@file{ada-xref.el}: GNAT cross-references, completion of identifiers,
-and compilation. Also provides project files (which are not
-GNAT-specific).
-
-@end itemize
-
-@node Customization
-@chapter Customizing Ada mode
-
-Here we assume you are familiar with setting variables in Emacs,
-either thru 'customize' or in elisp (in your @file{.emacs} file). For
-a basic introduction to customize, elisp, and Emacs in general, see
-the tutorial in
-@iftex
-@cite{The GNU Emacs Manual}.
-@end iftex
-@ifhtml
-@cite{The GNU Emacs Manual}.
-@end ifhtml
-@ifinfo
-@ref{Top, , The GNU Emacs Manual, emacs, The GNU Emacs Manual}.
-@end ifinfo
-
-These global Emacs settings are strongly recommended (put them in your
-.emacs):
-
-@example
-(global-font-lock-mode t)
-(transient-mark-mode t)
-@end example
-
-@samp{(global-font-lock-mode t)} turns on syntax
-highlighting for all buffers (it is off by default because it may be
-too slow for some machines).
-
-@samp{(transient-mark-mode t)} highlights selected text.
-
-See the Emacs help for each of these variables for more information.
-
-@menu
-* Non-standard file names::
-* Other compiler::
-* Other customization::
-@end menu
-
-@node Non-standard file names
-@section Non-standard file names
-
-By default, Ada mode is configured to use the GNAT file naming
-convention, where file names are a simple modification of the Ada
-names, and the extension for specs and bodies are
-@samp{.ads} and @samp{.adb}, respectively.
-
-Ada mode uses the file extensions to allow moving from a package body
-to the corresponding spec and back.
-
-Ada mode supports a list of alternative file extensions for specs and bodies.
-
-For instance, if your spec and bodies files are called
-@file{@var{unit}_s.ada} and @file{@var{unit}_b.ada}, respectively, you
-can add the following to your @file{.emacs} file:
-
-@example
-(ada-add-extensions "_s.ada" "_b.ada")
-@end example
-
-You can define additional extensions:
-
-@example
-(ada-add-extensions ".ads" "_b.ada")
-(ada-add-extensions ".ads" ".body")
-@end example
-
-This means that whenever Ada mode looks for the body for a file
-whose extension is @file{.ads}, it will take the first available file
-that ends with either @file{.adb}, @file{_b.ada} or
-@file{.body}.
-
-Similarly, if Ada mode is looking for a spec, it will look for
-@file{.ads} or @file{_s.ada}.
-
-If the filename is not derived from the Ada name following the GNAT
-convention, things are a little more complicated. You then need to
-rewrite the function @code{ada-make-filename-from-adaname}. Doing that
-is beyond the scope of this manual; see the current definitions in
-@file{ada-mode.el} and @file{ada-xref.el} for examples.
-
-@node Other compiler
-@section Other compiler
-
-By default, Ada mode is configured to use the GNU Ada compiler GNAT.
-
-To use a different Ada compiler, you must specify the command lines
-used to run that compiler, either in lisp variables or in Emacs
-Ada mode project files. See @ref{Project file variables} for the list
-of project variables, and the corresponding lisp variables.
-
-@node Other customization
-@section Other customization
-
-All user-settable Ada mode variables can be set via the menu
-@samp{Ada | Customize}. Click on the @samp{Help} button there for help
-on using customize.
-
-To modify a specific variable, you can directly call the function
-@code{customize-variable}; just type @kbd{M-x customize-variable
-@key{RET} @var{variable-name} @key{RET}}).
-
-Alternately, you can specify variable settings in the Emacs
-configuration file, @file{.emacs}. This file is coded in Emacs lisp,
-and the syntax to set a variable is the following:
-@example
-(setq variable-name value)
-@end example
-
-@node Compiling Executing
-@chapter Compiling Executing
-
-Ada projects can be compiled, linked, and executed using commands on
-the Ada menu. All of these commands can be customized via a project
-file (@pxref{Project files}), but the defaults are sufficient for using
-the GNAT compiler for simple projects (single files, or several files
-in a single directory).
-
-Even when no project file is used, the GUI project editor (menu
-@samp{Ada | Project | Edit}) shows the settings of the various project
-file variables referenced here.
-
-@menu
-* Compile commands::
-* Compiler errors::
-@end menu
-
-@node Compile commands
-@section Compile commands
-
-Here are the commands for building and using an Ada project, as
-listed in the Ada menu.
-
-In multi-file projects, there must be one file that is the main
-program. That is given by the @code{main} project file variable;
-it defaults to the current file if not yet set, but is also set by the
-``set main and build'' command.
-
-@table @code
-
-@item Check file
-Compiles the current file in syntax check mode, by running
-@code{check_cmd} defined in the current project file. This typically
-runs faster than full compile mode, speeding up finding and fixing
-compilation errors.
-
-This sets @code{main} only if it has not been set yet.
-
-@item Compile file
-Compiles the current file, by running @code{comp_cmd} from the current
-project file.
-
-This does not set @code{main}.
-
-@item Set main and Build
-Sets @code{main} to the current file, then executes the Build
-command.
-
-@item Show main
-Display @code{main} in the message buffer.
-
-@item Build
-Compiles all obsolete units of the current @code{main}, and links
-@code{main}, by running @code{make_cmd} from the current project.
-
-This sets @code{main} only if it has not been set yet.
-
-@item Run
-Executes the main program in a shell, displayed in a separate Emacs
-buffer. This runs @code{run_cmd} from the current project. The
-execution buffer allows for interactive input/output.
-
-To modify the run command, in particular to provide or change the
-command line arguments, type @kbd{C-u} before invoking the command.
-
-This command is not available for a cross-compilation toolchain.
-
-@end table
-It is important when using these commands to understand how
-@code{main} is used and changed.
-
-Build runs 'gnatmake' on the main unit. During a typical edit/compile
-session, this is the only command you need to invoke, which is why it
-is bound to @kbd{C-c C-c}. It will compile all files needed by the
-main unit, and display compilation errors in any of them.
-
-Note that Build can be invoked from any Ada buffer; typically you will
-be fixing errors in files other than the main, but you don't have to
-switch back to the main to invoke the compiler again.
-
-Novices and students typically work on single-file Ada projects. In
-this case, @kbd{C-c C-m} will normally be the only command needed; it
-will build the current file, rather than the last-built main.
-
-There are three ways to change @code{main}:
-
-@enumerate
-@item
-Invoke @samp{Ada | Set main and Build}, which sets @code{main} to
-the current file.
-
-@item
-Invoke @samp{Ada | Project | Edit}, edit @code{main} and
-@code{main}, and click @samp{[save]}
-
-@item
-Invoke @samp{Ada | Project | Load}, and load a project file that specifies
@code{main}
-
-@end enumerate
-
-@node Compiler errors
-@section Compiler errors
-
-The @code{Check file}, @code{Compile file}, and @code{Build} commands
-all place compilation errors in a separate buffer named
-@file{*compilation*}.
-
-Each line in this buffer will become active: you can simply click on
-it with the middle button of the mouse, or move point to it and press
-@key{RET}. Emacs will then display the relevant source file and put
-point on the line and column where the error was found.
-
-You can also press the @kbd{C-x `} key (@code{next-error}), and Emacs
-will jump to the first error. If you press that key again, it will
-move you to the second error, and so on.
-
-Some error messages might also include references to other files. These
-references are also clickable in the same way, or put point after the
-line number and press @key{RET}.
-
-@node Project files
-@chapter Project files
-
-An Emacs Ada mode project file specifies what directories hold sources
-for your project, and allows you to customize the compilation commands
-and other things on a per-project basis.
-
-Note that Ada mode project files @file{*.adp} are different than GNAT
-compiler project files @file{*.gpr}. However, Emacs Ada mode can use a
-GNAT project file to specify the project directories. If no
-other customization is needed, a GNAT project file can be used without
-an Emacs Ada mode project file.
-
-@menu
-* Project File Overview::
-* GUI Editor::
-* Project file variables::
-@end menu
-
-@node Project File Overview
-@section Project File Overview
-
-Project files have a simple syntax; they may be edited directly. Each
-line specifies a project variable name and its value, separated by ``='':
-@example
-src_dir=/Projects/my_project/src_1
-src_dir=/Projects/my_project/src_2
-@end example
-
-Some variables (like @code{src_dir}) are lists; multiple occurrences
-are concatenated.
-
-There must be no space between the variable name and ``='', and no
-trailing spaces.
-
-Alternately, a GUI editor for project files is available (@pxref{GUI
-Editor}). It uses Emacs widgets, similar to Emacs customize.
-
-The GUI editor also provides a convenient way to view current project
-settings, if they have been modified using menu commands rather than
-by editing the project file.
-
-After the first Ada mode build command is invoked, there is always a
-current project file, given by the lisp variable
-@code{ada-prj-default-project-file}. Currently, the only way to show
-the current project file is to invoke the GUI editor.
-
-To find the project file the first time, Ada mode uses the following
-search algorithm:
-
-@itemize @bullet
-@item
-If @code{ada-prj-default-project-file} is set, use that.
-
-@item
-Otherwise, search for a file in the current directory with
-the same base name as the Ada file, but extension given by
-@code{ada-prj-file-extension} (default @code{".adp"}).
-
-@item
-If not found, search for @file{*.adp} in the current directory; if
-several are found, prompt the user to select one.
-
-@item
-If none are found, use @file{default.adp} in the current directory (even
-if it does not exist).
-
-@end itemize
-
-This algorithm always sets @code{ada-prj-default-project-file}, even
-when the file does not actually exist.
-
-To change the project file before or after the first one is found,
-invoke @samp{Ada | Project | Load ...}.
-
-Or, in lisp, evaluate @code{(ada-set-default-project-file "/path/file.adp")}.
-This sets @code{ada-prj-default-project-file}, and reads the project file.
-
-You can also specify a GNAT project file to @samp{Ada | Project | Load
-...} or @code{ada-set-default-project-file}. Emacs Ada mode checks the
-file extension; if it is @code{.gpr}, the file is treated as a GNAT
-project file. Any other extension is treated as an Emacs Ada mode
-project file.
-
-@node GUI Editor
-@section GUI Editor
-
-The project file editor is invoked with the menu @samp{Ada | Projects
-| Edit}.
-
-Once in the buffer for editing the project file, you can save your
-modification using the @samp{[save]} button at the bottom of the
-buffer, or the @kbd{C-x C-s} binding. To cancel your modifications,
-kill the buffer or click on the @samp{[cancel]} button.
-
-@node Project file variables
-@section Project file variables
-
-The following variables can be defined in a project file; some can
-also be defined in lisp variables.
-
-To set a project variable that is a list, specify each element of the
-list on a separate line in the project file.
-
-Any project variable can be referenced in other project variables,
-using a shell-like notation. For instance, if the variable
-@code{comp_cmd} contains @code{$@{comp_opt@}}, the value of the
-@code{comp_opt} variable will be substituted when @code{comp_cmd} is
-used.
-
-In addition, process environment variables can be referenced using the
-same syntax, or the normal @code{$var} syntax.
-
-Most project variables have defaults that can be changed by setting
-lisp variables; the table below identifies the lisp variable for each
-project variable. Lisp variables corresponding to project variables
-that are lists are lisp lists.
-
-In general, project variables are evaluated when referenced in
-Emacs Ada mode commands. Relative file paths are expanded to
-absolute relative to @code{$@{build_dir@}}.
-
-Here is the list of variables. In the default values, the current
-directory @code{"."} is the project file directory.
-
-@table @asis
-@c defined in ada-default-prj-properties; alphabetical order
-
-@item @code{ada_project_path_sep} [default: @code{":" or ";"}]
-Path separator for @code{ADA_PROJECT_PATH}. It defaults to the correct
-value for a native implementation of GNAT for the current operating
-system. The user must override this when using Windows native GNAT
-with Cygwin Emacs, and perhaps in other cases.
-
-Lisp variable: @code{ada-prj-ada-project-path-sep}.
-
-@item @code{ada_project_path} [default: @code{""}]
-A list of directories to search for GNAT project files.
-
-If set, the @code{ADA_PROJECT_PATH} process environment variable is
-set to this value in the Emacs process when the Emacs Ada mode project
-is selected via menu @samp{Ada | Project | Load}.
-
-For @code{ada_project_path}, relative file paths are expanded to
-absolute when the Emacs Ada project file is read, rather than when the
-project file is selected.
-
-For example if the project file is in the directory
-@file{/home/myproject}, the environment variable @code{GDS_ROOT} is
-set to @code{/home/shared}, and the project file contains:
-@example
-ada_project_path_sep=:
-ada_project_path=$GDS_ROOT/makerules
-ada_project_path=../opentoken
-@end example
-then as a result the environment variable @code{ADA_PROJECT_PATH} will
-be set to @code{"/home/shared/makerules:/home/opentoken/"}.
-
-The default value is not the current value of this environment
-variable, because that will typically have been set by another
-project, and will therefore be incorrect for this project.
-
-If you have the environment variable set correctly for all of your
-projects, you do not need to set this project variable.
-
-@item @code{bind_opt} [default: @code{""}]
-Holds user binder options; used in the default build commands.
-
-Lisp variable: @code{ada-prj-default-bind-opt}.
-
-@item @code{build_dir} [default: @code{"."}]
-The compile commands will be issued in this directory.
-
-@item @code{casing} [default: @code{("~/.emacs_case_exceptions")}]
-List of files containing casing exceptions. See the help on
-@code{ada-case-exception-file} for more info.
-@c FIXME: section on case exceptions
-
-Lisp variable: @code{ada-case-exception-file}.
-
-@item @code{check_cmd} [default: @code{"$@{cross_prefix@}gnatmake -u -c
-gnatc $@{gnatmake_opt@} $@{full_current@} -cargs $@{comp_opt@}"}]
-Command used to syntax check a single file.
-The name of the file is substituted for @code{full_current}.
-
-Lisp variable: @code{ada-prj-default-check-cmd}
-
-@item @code{comp_cmd} [default: @code{"$@{cross_prefix@}gnatmake -u -c
$@{gnatmake_opt@} $@{full_current@} -cargs $@{comp_opt@}"}]
-Command used to compile a single file.
-The name of the file is substituted for @code{full_current}.
-
-Lisp variable: @code{ada-prj-default-comp-cmd}.
-
-@item @code{comp_opt} [default: @code{"-gnatq -gnatQ"}]
-Holds user compiler options; used in the default compile commands. The
-default value tells gnatmake to generate library files for
-cross-referencing even when there are errors.
-
-If source code for the project is in multiple directories, the
-appropriate compiler options must be added here. @ref{Set source
-search path} for examples of this. Alternately, GNAT project files may
-be used; @ref{Use GNAT project file}.
-
-Lisp variable: @code{ada-prj-default-comp-opt}.
-
-@item @code{cross_prefix} [default: @code{""}]
-Name of target machine in a cross-compilation environment. Used in
-default compile and build commands.
-
-@item @code{debug_cmd} [default: @code{"$@{cross_prefix@}gdb $@{main@}"}]
-Command used to debug the application
-
-Lisp variable: @code{ada-prj-default-debugger}.
-
-@item @code{debug_post_cmd} [default: @code{""}]
-Command executed after @code{debug_cmd}.
-
-@item @code{debug_pre_cmd} [default: @code{"cd $@{build_dir@}"}]
-Command executed before @code{debug_cmd}.
-
-@item @code{gnatfind_opt} [default: @code{"-rf"}]
-Holds user gnatfind options; used in the default find commands.
-
-Lisp variable: @code{ada-prj-gnatfind-switches}.
-
-@item @code{gnatmake_opt} [default: @code{"-g"}]
-Holds user gnatmake options; used in the default build commands.
-
-Lisp variable: @code{ada-prj-default-gnatmake-opt}.
-
-@item @code{gpr_file} [default: @code{""}]
-Specify GNAT project file.
-
-If set, the source and object directories specified in the GNAT
-project file are appended to @code{src_dir} and @code{obj_dir}. This
-allows specifying Ada source directories with a GNAT project file, and
-other source directories with the Emacs project file.
-
-In addition, @code{-P@{gpr_file@}} is added to the project variable
-@code{gnatmake_opt} whenever it is referenced. With the default
-project variables, this passes the project file to all gnatmake
-commands.
-
-Lisp variable: @code{ada-prj-default-gpr-file}.
-
-@c FIXME: add gnatstub-opts
-
-@item @code{link_opt} [default: @code{""}]
-Holds user linker options; used in the default build commands.
-
-Lisp variable: @code{ada-prj-default-link-opt}.
-
-@item @code{main} [default: current file]
-Specifies the name of the executable file for the project; used in the
-default build commands.
-
-@item @code{make_cmd} [default: @code{"$@{cross_prefix@}gnatmake -o
$@{main@} $@{main@} $@{gnatmake_opt@} -cargs $@{comp_opt@} -bargs $@{bind_opt@}
-largs $@{link_opt@}"}]
-Command used to build the application.
-
-Lisp variable: @code{ada-prj-default-make-cmd}.
-
-@item @code{obj_dir} [default: @code{"."}]
-A list of directories to search for library files. Ada mode searches
-this list for the @samp{.ali} files generated by GNAT that contain
-cross-reference information.
-
-The compiler commands must place the @samp{.ali} files in one of these
-directories; the default commands do that.
-
-@item @code{remote_machine} [default: @code{""}]
-Name of the machine to log into before issuing the compile and build
-commands. If this variable is empty, the command will be run on the
-local machine.
-
-@item @code{run_cmd} [default: @code{"./$@{main@}"}]
-Command used to run the application.
-
-@item @code{src_dir} [default: @code{"."}]
-A list of directories to search for source files, both for compile
-commands and source navigation.
-
-@end table
-
-@node Compiling Examples
-@chapter Compiling Examples
-
-We present several small projects, and walk thru the process of
-compiling, linking, and running them.
-
-The first example illustrates more Ada mode features than the others;
-you should work thru that example before doing the others.
-
-All of these examples assume you are using GNAT.
-
-The source for these examples is available on the Emacs Ada mode
-website mentioned in @xref{Installation}.
-
-@menu
-* No project files:: Just menus
-* Set compiler options:: A basic Ada mode project file
-* Set source search path:: Source in multiple directories
-* Use GNAT project file::
-* Use multiple GNAT project files::
-@end menu
-
-@node No project files
-@section No project files
-This example uses no project files.
-
-First, create a directory @file{Example_1}, containing:
-
-@file{hello.adb}:
-
-@example
-with Ada.Text_IO;
-procedure Hello
-is begin
- Put_Line("Hello from hello.adb");
-end Hello;
-@end example
-
-Yes, this is missing ``use Ada.Text_IO;'' - we want to demonstrate
-compiler error handling.
-
-@file{hello_2.adb}:
-
-@example
-with Hello_Pkg;
-procedure Hello_2
-is begin
- Hello_Pkg.Say_Hello;
-end Hello_2;
-@end example
-
-This file has no errors.
-
-@file{hello_pkg.ads}:
-
-@example
-package Hello_Pkg is
- procedure Say_Hello;
-end Hello_Pkg;
-@end example
-
-This file has no errors.
-
-@file{hello_pkg.adb}:
-
-@example
-with Ada.Text_IO;
-package Hello_Pkg is
- procedure Say_Hello
- is begin
- Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
- end Say_Hello;
-end Hello_Pkg;
-@end example
-
-Yes, this is missing the keyword @code{body}; another compiler error
-example.
-
-In buffer @file{hello.adb}, invoke @samp{Ada | Check file}. You should
-get a @file{*compilation*} buffer containing something like (the
-directory paths will be different):
-
-@smallexample
-cd c:/Examples/Example_1/
-gnatmake -u -c -gnatc -g c:/Examples/Example_1/hello.adb -cargs -gnatq -gnatQ
-gcc -c -Ic:/Examples/Example_1/ -gnatc -g -gnatq -gnatQ -I-
c:/Examples/Example_1/hello.adb
-hello.adb:4:04: "Put_Line" is not visible
-hello.adb:4:04: non-visible declaration at a-textio.ads:264
-hello.adb:4:04: non-visible declaration at a-textio.ads:260
-gnatmake: "c:/Examples/Example_1/hello.adb" compilation error
-@end smallexample
-
-If you have enabled font-lock, the lines with actual errors (starting
-with @file{hello.adb}) are highlighted, with the file name in red.
-
-Now type @kbd{C-x `} (on a PC keyboard, @key{`} is next to @key{1}).
-Or you can click the middle mouse button on the first error line. The
-compilation buffer scrolls to put the first error on the top line, and
-point is put at the place of the error in the @file{hello.adb} buffer.
-
-To fix the error, change the line to be
-
-@example
- Ada.Text_IO.Put_Line ("hello from hello.adb");
-@end example
-
-Now invoke @samp{Ada | Show main}; this displays @samp{Ada mode main: hello}.
-
-Now (in buffer @file{hello.adb}), invoke @samp{Ada | Build}. You are
-prompted to save the file (if you haven't already). Then the
-compilation buffer is displayed again, containing:
-
-@example
-cd c:/Examples/Example_1/
-gnatmake -o hello hello -g -cargs -gnatq -gnatQ -bargs -largs
-gcc -c -g -gnatq -gnatQ hello.adb
-gnatbind -x hello.ali
-gnatlink hello.ali -o hello.exe -g
-@end example
-
-The compilation has succeeded without errors; @file{hello.exe} now
-exists in the same directory as @file{hello.adb}.
-
-Now invoke @samp{Ada | Run}. A @file{*run*} buffer is displayed,
-containing
-
-@example
-Hello from hello.adb
-
-Process run finished
-@end example
-
-That completes the first part of this example.
-
-Now we will compile a multi-file project. Open the file
-@file{hello_2.adb}, and invoke @samp{Ada | Set main and Build}. This
-finds an error in @file{hello_pkg.adb}:
-
-@example
-cd c:/Examples/Example_1/
-gnatmake -o hello_2 hello_2 -g -cargs -gnatq -gnatQ -bargs -largs
-gcc -c -g -gnatq -gnatQ hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "hello_pkg.adb" compilation error
-@end example
-
-This demonstrates that gnatmake finds the files needed by the main
-program. However, it cannot find files in a different directory,
-unless you use an Emacs Ada mode project file to specify the other directories;
-@xref{Set source search path}, or a GNAT project file; @ref{Use GNAT
-project file}.
-
-Invoke @samp{Ada | Show main}; this displays @file{Ada mode main: hello_2}.
-
-Move to the error with @kbd{C-x `}, and fix the error by adding @code{body}:
-
-@example
-package body Hello_Pkg is
-@end example
-
-Now, while still in @file{hello_pkg.adb}, invoke @samp{Ada | Build}.
-gnatmake successfully builds @file{hello_2}. This demonstrates that
-Emacs has remembered the main file, in the project variable
-@code{main}, and used it for the Build command.
-
-Finally, again while in @file{hello_pkg.adb}, invoke @samp{Ada | Run}.
-The @file{*run*} buffer displays @code{Hello from hello_pkg.adb}.
-
-One final point. If you switch back to buffer @file{hello.adb}, and
-invoke @samp{Ada | Run}, @file{hello_2.exe} will be run. That is
-because @code{main} is still set to @code{hello_2}, as you can
-see when you invoke @samp{Ada | Project | Edit}.
-
-There are three ways to change @code{main}:
-
-@enumerate
-@item
-Invoke @samp{Ada | Set main and Build}, which sets @code{main} to
-the current file.
-
-@item
-Invoke @samp{Ada | Project | Edit}, edit @code{main}, and click @samp{[save]}
-
-@item
-Invoke @samp{Ada | Project | Load}, and load a project file that specifies
@code{main}
-
-@end enumerate
-
-@node Set compiler options
-@section Set compiler options
-
-This example illustrates using an Emacs Ada mode project file to set a
-compiler option.
-
-If you have files from @file{Example_1} open in Emacs, you should
-close them so you don't get confused. Use menu @samp{File | Close
-(current buffer)}.
-
-In directory @file{Example_2}, create these files:
-
-@file{hello.adb}:
-
-@example
-with Ada.Text_IO;
-procedure Hello
-is begin
- Put_Line("Hello from hello.adb");
-end Hello;
-@end example
-
-This is the same as @file{hello.adb} from @file{Example_1}. It has two
-errors; missing ``use Ada.Text_IO;'', and no space between
-@code{Put_Line} and its argument list.
-
-@file{hello.adp}:
-
-@example
-comp_opt=-gnatyt
-@end example
-
-This tells the GNAT compiler to check for token spacing; in
-particular, there must be a space preceding a parenthesis.
-
-In buffer @file{hello.adb}, invoke @samp{Ada | Project | Load...}, and
-select @file{Example_2/hello.adp}.
-
-Then, again in buffer @file{hello.adb}, invoke @samp{Ada | Set main and
-Build}. You should get a @file{*compilation*} buffer containing
-something like (the directory paths will be different):
-
-@example
-cd c:/Examples/Example_2/
-gnatmake -o hello hello -g -cargs -gnatyt -bargs -largs
-gcc -c -g -gnatyt hello.adb
-hello.adb:4:04: "Put_Line" is not visible
-hello.adb:4:04: non-visible declaration at a-textio.ads:264
-hello.adb:4:04: non-visible declaration at a-textio.ads:260
-hello.adb:4:12: (style) space required
-gnatmake: "hello.adb" compilation error
-@end example
-
-Compare this to the compiler output in @ref{No project files}; the
-gnatmake option @code{-cargs -gnatq -gnatQ} has been replaced by
-@code{-cargs -gnaty}, and an additional error is reported in
-@file{hello.adb} on line 4. This shows that @file{hello.adp} is being
-used to set the compiler options.
-
-Fixing the error, linking and running the code proceed as in @ref{No
-project files}.
-
-@node Set source search path
-@section Set source search path
-
-In this example, we show how to deal with files in more than one
-directory. We start with the same code as in @ref{No project files};
-create those files (with the errors present)
-
-Create the directory @file{Example_3}, containing:
-
-@file{hello_pkg.ads}:
-
-@example
-package Hello_Pkg is
- procedure Say_Hello;
-end Hello_Pkg;
-@end example
-
-@file{hello_pkg.adb}:
-
-@example
-with Ada.Text_IO;
-package Hello_Pkg is
- procedure Say_Hello
- is begin
- Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
- end Say_Hello;
-end Hello_Pkg;
-@end example
-
-These are the same files from example 1; @file{hello_pkg.adb} has an
-error on line 2.
-
-In addition, create a directory @file{Example_3/Other}, containing these files:
-
-@file{Other/hello_3.adb}:
-
-@example
-with Hello_Pkg;
-with Ada.Text_IO; use Ada.Text_IO;
-procedure Hello_3
-is begin
- Hello_Pkg.Say_Hello;
- Put_Line ("From hello_3");
-end Hello_3;
-@end example
-
-There are no errors in this file.
-
-@file{Other/other.adp}:
-
-@example
-src_dir=..
-comp_opt=-I..
-@end example
-
-Note that there must be no trailing spaces.
-
-In buffer @file{hello_3.adb}, invoke @samp{Ada | Project | Load...}, and
-select @file{Example_3/Other/other.adp}.
-
-Then, again in @file{hello_3.adb}, invoke @samp{Ada | Set main and
-Build}. You should get a @file{*compilation*} buffer containing
-something like (the directory paths will be different):
-
-@example
-cd c:/Examples/Example_3/Other/
-gnatmake -o hello_3 hello_3 -g -cargs -I.. -bargs -largs
-gcc -c -g -I.. hello_3.adb
-gcc -c -I./ -g -I.. -I- C:\Examples\Example_3\hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "C:\Examples\Example_3\hello_pkg.adb" compilation error
-@end example
-
-Compare the @code{-cargs} option to the compiler output in @ref{Set
-compiler options}; this shows that @file{other.adp} is being used to
-set the compiler options.
-
-Move to the error with @kbd{C-x `}. Ada mode searches the list of
-directories given by @code{src_dir} for the file mentioned in the
-compiler error message.
-
-Fixing the error, linking and running the code proceed as in @ref{No
-project files}.
-
-@node Use GNAT project file
-@section Use GNAT project file
-
-In this example, we show how to use a GNAT project file, with no Ada
-mode project file.
-
-Create the directory @file{Example_4}, containing:
-
-@file{hello_pkg.ads}:
-
-@example
-package Hello_Pkg is
- procedure Say_Hello;
-end Hello_Pkg;
-@end example
-
-@file{hello_pkg.adb}:
-
-@example
-with Ada.Text_IO;
-package Hello_Pkg is
- procedure Say_Hello
- is begin
- Ada.Text_IO.Put_Line ("Hello from hello_pkg.adb");
- end Say_Hello;
-end Hello_Pkg;
-@end example
-
-These are the same files from example 1; @file{hello_pkg.adb} has an
-error on line 2.
-
-In addition, create a directory @file{Example_4/Gnat_Project},
-containing these files:
-
-@file{Gnat_Project/hello_4.adb}:
-
-@example
-with Hello_Pkg;
-with Ada.Text_IO; use Ada.Text_IO;
-procedure Hello_4
-is begin
- Hello_Pkg.Say_Hello;
- Put_Line ("From hello_4");
-end Hello_4;
-@end example
-
-There are no errors in this file.
-
-@file{Gnat_Project/hello_4.gpr}:
-
-@example
-Project Hello_4 is
- for Source_Dirs use (".", "..");
-end Hello_4;
-@end example
-
-In buffer @file{hello_4.adb}, invoke @samp{Ada | Project | Load...}, and
-select @file{Example_4/Gnat_Project/hello_4.gpr}.
-
-Then, again in @file{hello_4.adb}, invoke @samp{Ada | Set main and
-Build}. You should get a @file{*compilation*} buffer containing
-something like (the directory paths will be different):
-
-@smallexample
-cd c:/Examples/Example_4/Gnat_Project/
-gnatmake -o hello_4 hello_4 -Phello_4.gpr -cargs -gnatq -gnatQ -bargs -largs
-gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA
c:\Examples\Example_4\Gnat_Project\hello_4.adb
-gcc -c -g -gnatyt -gnatq -gnatQ -I- -gnatA c:\Examples\Example_4\hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error
-@end smallexample
-
-Compare the @code{gcc} options to the compiler output in @ref{Set
-compiler options}; this shows that @file{hello_4.gpr} is being used to
-set the compiler options.
-
-Fixing the error, linking and running the code proceed as in @ref{No
-project files}.
-
-@node Use multiple GNAT project files
-@section Use multiple GNAT project files
-
-In this example, we show how to use multiple GNAT project files,
-specifying the GNAT project search path in an Ada mode project file.
-
-Create the directory @file{Example_4} as specified in @ref{Use GNAT
-project file}.
-
-Create the directory @file{Example_5}, containing:
-
-@file{hello_5.adb}:
-
-@example
-with Hello_Pkg;
-with Ada.Text_IO; use Ada.Text_IO;
-procedure Hello_5
-is begin
- Hello_Pkg.Say_Hello;
- Put_Line ("From hello_5");
-end Hello_5;
-@end example
-
-There are no errors in this file.
-
-@file{hello_5.adp}:
-
-@example
-ada_project_path=../Example_4/Gnat_Project
-gpr_file=hello_5.gpr
-@end example
-
-@file{hello_5.gpr}:
-
-@example
-with "hello_4";
-Project Hello_5 is
- for Source_Dirs use (".");
- package Compiler is
- for Default_Switches ("Ada") use ("-g", "-gnatyt");
- end Compiler;
-end Hello_5;
-@end example
-
-In buffer @file{hello_5.adb}, invoke @samp{Ada | Project | Load...}, and
-select @file{Example_5/hello_5.adp}.
-
-Then, again in @file{hello_5.adb}, invoke @samp{Ada | Set main and
-Build}. You should get a @file{*compilation*} buffer containing
-something like (the directory paths will be different):
-
-@smallexample
-cd c:/Examples/Example_5/
-gnatmake -o hello_5 hello_5 -Phello_5.gpr -g -cargs -gnatq -gnatQ -bargs
-largs
-gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA c:\Examples\Example_5\hello_5.adb
-gcc -c -g -gnatyt -g -gnatq -gnatQ -I- -gnatA
c:\Examples\Example_4\hello_pkg.adb
-hello_pkg.adb:2:08: keyword "body" expected here [see file name]
-gnatmake: "c:\examples\example_4\hello_pkg.adb" compilation error
-@end smallexample
-
-Now type @kbd{C-x `}. @file{Example_4/hello_pkg.adb} is shown,
-demonstrating that @file{hello_5.gpr} and @file{hello_4.gpr} are being
-used to set the compilation search path.
-
-@node Moving Through Ada Code
-@chapter Moving Through Ada Code
-
-There are several easy to use commands to navigate through Ada code. All
-these functions are available through the Ada menu, and you can also
-use the following key bindings or the command names. Some of these
-menu entries are available only if the GNAT compiler is used, since
-the implementation relies on the GNAT cross-referencing information.
-
-@table @kbd
-@item M-C-e
-@findex ada-next-procedure
-Move to the next function/procedure/task, which ever comes next
-(@code{ada-next-procedure}).
-@item M-C-a
-@findex ada-previous-procedure
-Move to previous function/procedure/task
-(@code{ada-previous-procedure}).
-@item M-x ada-next-package
-@findex ada-next-package
-Move to next package.
-@item M-x ada-previous-package
-@findex ada-previous-package
-Move to previous package.
-@item C-c C-a
-@findex ada-move-to-start
-Move to matching start of @code{end} (@code{ada-move-to-start}). If
-point is at the end of a subprogram, this command jumps to the
-corresponding @code{begin} if the user option
-@code{ada-move-to-declaration} is @code{nil} (default), otherwise it jumps to
-the subprogram declaration.
-@item C-c C-e
-@findex ada-move-to-end
-Move point to end of current block (@code{ada-move-to-end}).
-@item C-c o
-Switch between corresponding spec and body file
-(@code{ff-find-other-file}). If point is in a subprogram, position
-point on the corresponding declaration or body in the other file.
-@item C-c c-d
-@findex ada-goto-declaration
-Move from any reference to its declaration, for from a declaration to
-its body (for procedures, tasks, private and incomplete types).
-@item C-c C-r
-@findex ada-find-references
-Runs the @file{gnatfind} command to search for all references to the
-identifier surrounding point (@code{ada-find-references}). Use
-@kbd{C-x `} (@code{next-error}) to visit each reference (as for
-compilation errors).
-@end table
-
-If the @code{ada-xref-create-ali} variable is non-@code{nil}, Emacs
-will try to run GNAT for you whenever cross-reference information is
-needed, and is older than the current source file.
-
-@node Identifier completion
-@chapter Identifier completion
-
-Emacs and Ada mode provide two general ways for the completion of
-identifiers. This is an easy way to type faster: you just have to type
-the first few letters of an identifiers, and then loop through all the
-possible completions.
-
-The first method is general for Emacs. It works by parsing all open
-files for possible completions.
-
-For instance, if the words @samp{my_identifier}, @samp{my_subprogram}
-are the only words starting with @samp{my} in any of the opened files,
-then you will have this scenario:
-
-@example
-You type: my@kbd{M-/}
-Emacs inserts: @samp{my_identifier}
-If you press @kbd{M-/} once again, Emacs replaces @samp{my_identifier} with
-@samp{my_subprogram}.
-Pressing @kbd{M-/} once more will bring you back to @samp{my_identifier}.
-@end example
-
-This is a very fast way to do completion, and the casing of words will
-also be respected.
-
-The second method (@kbd{C-@key{TAB}}) is specific to Ada mode and the GNAT
-compiler. Emacs will search the cross-information for possible
-completions.
-
-The main advantage is that this completion is more accurate: only
-existing identifier will be suggested.
-
-On the other hand, this completion is a little bit slower and requires
-that you have compiled your file at least once since you created that
-identifier.
-
-@table @kbd
-@item C-@key{TAB}
-@findex ada-complete-identifier
-Complete current identifier using cross-reference information.
-@item M-/
-Complete identifier using buffer information (not Ada-specific).
-@end table
-
-@node Automatic Smart Indentation
-@chapter Automatic Smart Indentation
-
-Ada mode comes with a full set of rules for automatic indentation. You
-can also configure the indentation, via the following variables:
-
-@table @asis
-@item @code{ada-broken-indent} (default value: 2)
-Number of columns to indent the continuation of a broken line.
-
-@item @code{ada-indent} (default value: 3)
-Number of columns for default indentation.
-
-@item @code{ada-indent-record-rel-type} (default value: 3)
-Indentation for @code{record} relative to @code{type} or @code{use}.
-
-@item @code{ada-indent-return} (default value: 0)
-Indentation for @code{return} relative to @code{function} (if
-@code{ada-indent-return} is greater than 0), or the open parenthesis
-(if @code{ada-indent-return} is negative or 0). Note that in the second
-case, when there is no open parenthesis, the indentation is done
-relative to @code{function} with the value of @code{ada-broken-indent}.
-
-@item @code{ada-label-indent} (default value: -4)
-Number of columns to indent a label.
-
-@item @code{ada-stmt-end-indent} (default value: 0)
-Number of columns to indent a statement @code{end} keyword on a separate line.
-
-@item @code{ada-when-indent} (default value: 3)
-Indentation for @code{when} relative to @code{exception} or @code{case}.
-
-@item @code{ada-indent-is-separate} (default value: t)
-Non-@code{nil} means indent @code{is separate} or @code{is abstract} if on a
single line.
-
-@item @code{ada-indent-to-open-paren} (default value: t)
-Non-@code{nil} means indent according to the innermost open parenthesis.
-
-@item @code{ada-indent-after-return} (default value: t)
-Non-@code{nil} means that the current line will also be re-indented
-before inserting a newline, when you press @key{RET}.
-@end table
-
-Most of the time, the indentation will be automatic, i.e., when you
-press @key{RET}, the cursor will move to the correct column on the
-next line.
-
-You can also indent single lines, or the current region, with @key{TAB}.
-
-Another mode of indentation exists that helps you to set up your
-indentation scheme. If you press @kbd{C-c @key{TAB}}, Ada mode will do
-the following:
-
-@itemize @bullet
-@item
-Reindent the current line, as @key{TAB} would do.
-@item
-Temporarily move the cursor to a reference line, i.e., the line that
-was used to calculate the current indentation.
-@item
-Display in the message window the name of the variable that provided
-the offset for the indentation.
-@end itemize
-
-The exact indentation of the current line is the same as the one for the
-reference line, plus an offset given by the variable.
-
-@table @kbd
-@item @key{TAB}
-Indent the current line or the current region.
-@item C-M-\
-Indent lines in the current region.
-@item C-c @key{TAB}
-Indent the current line and display the name of the variable used for
-indentation.
-@end table
-
-@node Formatting Parameter Lists
-@chapter Formatting Parameter Lists
-
-@table @kbd
-@item C-c C-f
-@findex ada-format-paramlist
-Format the parameter list (@code{ada-format-paramlist}).
-@end table
-
-This aligns the declarations on the colon (@samp{:}) separating
-argument names and argument types, and aligns the @code{in},
-@code{out} and @code{in out} keywords.
-
-@node Automatic Casing
-@chapter Automatic Casing
-
-Casing of identifiers, attributes and keywords is automatically
-performed while typing when the variable @code{ada-auto-case} is set.
-Every time you press a word separator, the previous word is
-automatically cased.
-
-You can customize the automatic casing differently for keywords,
-attributes and identifiers. The relevant variables are the following:
-@code{ada-case-keyword}, @code{ada-case-attribute} and
-@code{ada-case-identifier}.
-
-All these variables can have one of the following values:
-
-@table @code
-@item downcase-word
-The word will be lowercase. For instance @code{My_vARIable} is
-converted to @code{my_variable}.
-
-@item upcase-word
-The word will be uppercase. For instance @code{My_vARIable} is
-converted to @code{MY_VARIABLE}.
-
-@item ada-capitalize-word
-The first letter and each letter following an underscore (@samp{_})
-are uppercase, others are lowercase. For instance @code{My_vARIable}
-is converted to @code{My_Variable}.
-
-@item ada-loose-case-word
-Characters after an underscore @samp{_} character are uppercase,
-others are not modified. For instance @code{My_vARIable} is converted
-to @code{My_VARIable}.
-@end table
-
-Ada mode allows you to define exceptions to these rules, in a file
-specified by the variable @code{ada-case-exception-file}
-(default @file{~/.emacs_case_exceptions}). Each line in this file
-specifies the casing of one word or word fragment. Comments may be
-included, separated from the word by a space.
-
-If the word starts with an asterisk (@samp{*}), it defines the casing
-as a word fragment (or ``substring''); part of a word between two
-underscores or word boundary.
-
-For example:
-
-@example
-DOD Department of Defense
-*IO
-GNAT The GNAT compiler from Ada Core Technologies
-@end example
-
-The word fragment @code{*IO} applies to any word containing ``_io'';
-@code{Text_IO}, @code{Hardware_IO}, etc.
-
-@findex ada-create-case-exception
-There are two ways to add new items to this file: you can simply edit
-it as you would edit any text file. Or you can position point on the
-word you want to add, and select menu @samp{Ada | Edit | Create Case
-Exception}, or press @kbd{C-c C-y} (@code{ada-create-case-exception}).
-The word will automatically be added to the current list of exceptions
-and to the file.
-
-To define a word fragment case exception, select the word fragment,
-then select menu @samp{Ada | Edit | Create Case Exception Substring}.
-
-It is sometimes useful to have multiple exception files around (for
-instance, one could be the standard Ada acronyms, the second some
-company specific exceptions, and the last one some project specific
-exceptions). If you set up the variable @code{ada-case-exception-file}
-as a list of files, each of them will be parsed and used in your emacs
-session. However, when you save a new exception through the menu, as
-described above, the new exception will be added to the first file in
-the list.
-
-@table @kbd
-@item C-c C-b
-@findex ada-adjust-case-buffer
-Adjust case in the whole buffer (@code{ada-adjust-case-buffer}).
-@item C-c C-y
-Create a new entry in the exception dictionary, with the word under
-the cursor (@code{ada-create-case-exception})
-@item C-c C-t
-@findex ada-case-read-exceptions
-Rereads the exception dictionary from the file
-@code{ada-case-exception-file} (@code{ada-case-read-exceptions}).
-@end table
-
-@node Statement Templates
-@chapter Statement Templates
-
-Templates are defined for most Ada statements, using the Emacs
-``skeleton'' package. They can be inserted in the buffer using the
-following commands:
-
-@table @kbd
-@item C-c t b
-@findex ada-exception-block
-exception Block (@code{ada-exception-block}).
-@item C-c t c
-@findex ada-case
-case (@code{ada-case}).
-@item C-c t d
-@findex ada-declare-block
-declare Block (@code{ada-declare-block}).
-@item C-c t e
-@findex ada-else
-else (@code{ada-else}).
-@item C-c t f
-@findex ada-for-loop
-for Loop (@code{ada-for-loop}).
-@item C-c t h
-@findex ada-header
-Header (@code{ada-header}).
-@item C-c t i
-@findex ada-if
-if (@code{ada-if}).
-@item C-c t k
-@findex ada-package-body
-package Body (@code{ada-package-body}).
-@item C-c t l
-@findex ada-loop
-loop (@code{ada-loop}).
-@item C-c p
-@findex ada-subprogram-body
-subprogram body (@code{ada-subprogram-body}).
-@item C-c t t
-@findex ada-task-body
-task Body (@code{ada-task-body}).
-@item C-c t w
-@findex ada-while
-while Loop (@code{ada-while}).
-@item C-c t u
-@findex ada-use
-use (@code{ada-use}).
-@item C-c t x
-@findex ada-exit
-exit (@code{ada-exit}).
-@item C-c t C-a
-@findex ada-array
-array (@code{ada-array}).
-@item C-c t C-e
-@findex ada-elsif
-elsif (@code{ada-elsif}).
-@item C-c t C-f
-@findex ada-function-spec
-function Spec (@code{ada-function-spec}).
-@item C-c t C-k
-@findex ada-package-spec
-package Spec (@code{ada-package-spec}).
-@item C-c t C-p
-@findex ada-procedure-spec
-procedure Spec (@code{ada-package-spec}.
-@item C-c t C-r
-@findex ada-record
-record (@code{ada-record}).
-@item C-c t C-s
-@findex ada-subtype
-subtype (@code{ada-subtype}).
-@item C-c t C-t
-@findex ada-task-spec
-task Spec (@code{ada-task-spec}).
-@item C-c t C-u
-@findex ada-with
-with (@code{ada-with}).
-@item C-c t C-v
-@findex ada-private
-private (@code{ada-private}).
-@item C-c t C-w
-@findex ada-when
-when (@code{ada-when}).
-@item C-c t C-x
-@findex ada-exception
-exception (@code{ada-exception}).
-@item C-c t C-y
-@findex ada-type
-type (@code{ada-type}).
-@end table
-
-@node Comment Handling
-@chapter Comment Handling
-
-By default, comment lines get indented like Ada code. There are a few
-additional functions to handle comments:
-
-@table @kbd
-@item M-;
-Start a comment in default column.
-@item M-j
-Continue comment on next line.
-@item C-c ;
-Comment the selected region (add @samp{--} at the beginning of lines).
-@item C-c :
-Uncomment the selected region
-@item M-q
-autofill the current comment.
-@end table
-
-@node GNU Free Documentation License
-@appendix GNU Free Documentation License
-@include doclicense.texi
-
-@node Index
-@unnumbered Index
-
-@printindex fn
-
-@bye
diff --git a/etc/NEWS b/etc/NEWS
index 56e5fd2..7c329f0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1835,6 +1835,11 @@ This results in the use of Gravatar's default size of 80
pixels.
This is possible using the new user options 'gravatar-default-image'
and 'gravatar-force-default'.
+** ada-mode
+
+*** The built-in ada-mode is now deleted. The Gnu ELPA package is a
+good replacement, even in very large source files.
+
* New Modes and Packages in Emacs 27.1
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
deleted file mode 100644
index 4a4e1a7..0000000
--- a/lisp/progmodes/ada-mode.el
+++ /dev/null
@@ -1,5493 +0,0 @@
-;;; ada-mode.el --- major-mode for editing Ada sources
-
-;; Copyright (C) 1994-1995, 1997-2019 Free Software Foundation, Inc.
-
-;; Author: Rolf Ebert <address@hidden>
-;; Markus Heritsch <address@hidden>
-;; Emmanuel Briot <address@hidden>
-;; Maintainer: Stephen Leake <address@hidden>
-;; Keywords: languages ada
-;; Version: 4.0
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; This mode is a major mode for editing Ada code. This is a major
-;; rewrite of the file packaged with Emacs-20. The Ada mode is
-;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el
-;; and ada-stmt.el. Only this file (ada-mode.el) is completely
-;; independent from the GNU Ada compiler GNAT, distributed by Ada
-;; Core Technologies. All the other files rely heavily on features
-;; provided only by GNAT.
-
-;;; Usage:
-;; Emacs should enter Ada mode automatically when you load an Ada file.
-;; By default, the valid extensions for Ada files are .ads, .adb or .ada
-;; If the ada-mode does not start automatically, then simply type the
-;; following command :
-;; M-x ada-mode
-;;
-;; By default, ada-mode is configured to take full advantage of the GNAT
-;; compiler (the menus will include the cross-referencing features,...).
-;; If you are using another compiler, you might want to set the following
-;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it
-;; won't work) :
-;; (setq ada-which-compiler 'generic)
-;;
-;; This mode requires find-file.el to be present on your system.
-
-;;; History:
-;; The first Ada mode for GNU Emacs was written by V. Broman in
-;; 1985. He based his work on the already existing Modula-2 mode.
-;; This was distributed as ada.el in versions of Emacs prior to 19.29.
-;;
-;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of
-;; several files with support for dired commands and other nice
-;; things. It is currently available from the PAL
-;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z.
-;;
-;; The probably very first Ada mode (called electric-ada.el) was
-;; written by Steven D. Litvintchouk and Steven M. Rosen for the
-;; Gosling Emacs. L. Slater based his development on ada.el and
-;; electric-ada.el.
-;;
-;; A complete rewrite by M. Heritsch and R. Ebert has been done.
-;; Some ideas from the Ada mode mailing list have been
-;; added. Some of the functionality of L. Slater's mode has not
-;; (yet) been recoded in this new mode. Perhaps you prefer sticking
-;; to his version.
-;;
-;; A complete rewrite for Emacs-20 / GNAT-3.11 has been done by Ada Core
-;; Technologies.
-
-;;; Credits:
-;; Many thanks to John McCabe <address@hidden> for sending so
-;; many patches included in this package.
-;; Christian Egli <address@hidden>:
-;; ada-imenu-generic-expression
-;; Many thanks also to the following persons that have contributed
-;; to the ada-mode
-;; Philippe Waroquiers (PW) <address@hidden> in particular,
-;; address@hidden (John Woodruff)
-;; address@hidden (Jesper Joergensen)
-;; address@hidden (Scott Evans)
-;; address@hidden (Cyrille Comar)
-;; address@hidden (Stephen Leake)
-;; address@hidden
-;; and others for their valuable hints.
-
-;;; Code:
-;; Note: Every function in this package is compiler-independent.
-;; The names start with ada-
-;; The variables that the user can edit can all be modified through
-;; the customize mode. They are sorted in alphabetical order in this
-;; file.
-
-;; Supported packages.
-;; This package supports a number of other Emacs modes. These other modes
-;; should be loaded before the ada-mode, which will then setup some variables
-;; to improve the support for Ada code.
-;; Here is the list of these modes:
-;; `which-function-mode': Display in the mode line the name of the subprogram
-;; the cursor is in.
-;; `outline-mode': Provides the capability to collapse or expand the code
-;; for specific language constructs, for instance if you want to hide the
-;; code corresponding to a subprogram
-;; `align': This mode is now provided with Emacs 21, but can also be
-;; installed manually for older versions of Emacs. It provides the
-;; capability to automatically realign the selected region (for instance
-;; all ':=', ':' and '--' will be aligned on top of each other.
-;; `imenu': Provides a menu with the list of entities defined in the current
-;; buffer, and an easy way to jump to any of them
-;; `speedbar': Provides a separate file browser, and the capability for each
-;; file to see the list of entities defined in it and to jump to them
-;; easily
-;; `abbrev-mode': Provides the capability to define abbreviations, which
-;; are automatically expanded when you type them. See the Emacs manual.
-
-(require 'find-file nil t)
-(require 'align nil t)
-(require 'which-func nil t)
-(require 'compile nil t)
-
-(defvar ispell-check-comments)
-(defvar skeleton-further-elements)
-
-(define-error 'ada-mode-errors nil)
-
-(defun ada-mode-version ()
- "Return Ada mode version."
- (interactive)
- (let ((version-string "4.00"))
- (if (called-interactively-p 'interactive)
- (message version-string)
- version-string)))
-
-(defvar ada-mode-hook nil
- "List of functions to call when Ada mode is invoked.
-This hook is automatically executed after the `ada-mode' is
-fully loaded.
-This is a good place to add Ada environment specific bindings.")
-
-(defgroup ada nil
- "Major mode for editing and compiling Ada source in Emacs."
- :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
- :link '(custom-manual "(ada-mode) Top")
- :link '(emacs-commentary-link :tag "Commentary" "ada-mode.el")
- :group 'languages)
-
-(defcustom ada-auto-case t
- "Non-nil means automatically change case of preceding word while typing.
-Casing is done according to `ada-case-keyword', `ada-case-identifier'
-and `ada-case-attribute'."
- :type 'boolean :group 'ada)
-
-(defcustom ada-broken-decl-indent 0
- "Number of columns to indent a broken declaration.
-
-An example is :
- declare
- A,
- >>>>>B : Integer;"
- :type 'integer :group 'ada)
-
-(defcustom ada-broken-indent 2
- "Number of columns to indent the continuation of a broken line.
-
-An example is :
- My_Var : My_Type := (Field1 =>
- >>>>>>>>>Value);"
- :type 'integer :group 'ada)
-
-(defcustom ada-continuation-indent ada-broken-indent
- "Number of columns to indent the continuation of broken lines in parenthesis.
-
-An example is :
- Func (Param1,
- >>>>>Param2);"
- :type 'integer :group 'ada)
-
-(defcustom ada-case-attribute 'ada-capitalize-word
- "Function to call to adjust the case of Ada attributes.
-It may be `downcase-word', `upcase-word', `ada-loose-case-word',
-`ada-capitalize-word' or `ada-no-auto-case'."
- :type '(choice (const downcase-word)
- (const upcase-word)
- (const ada-capitalize-word)
- (const ada-loose-case-word)
- (const ada-no-auto-case))
- :group 'ada)
-
-(defcustom ada-case-exception-file
- (list (convert-standard-filename' "~/.emacs_case_exceptions"))
- "List of special casing exceptions dictionaries for identifiers.
-The first file is the one where new exceptions will be saved by Emacs
-when you call `ada-create-case-exception'.
-
-These files should contain one word per line, that gives the casing
-to be used for that word in Ada files. If the line starts with the
-character *, then the exception will be used for substrings that either
-start at the beginning of a word or after a _ character, and end either
-at the end of the word or at a _ character. Each line can be terminated
-by a comment."
- :type '(repeat (file))
- :group 'ada)
-
-(defcustom ada-case-keyword 'downcase-word
- "Function to call to adjust the case of an Ada keywords.
-It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
-`ada-capitalize-word'."
- :type '(choice (const downcase-word)
- (const upcase-word)
- (const ada-capitalize-word)
- (const ada-loose-case-word)
- (const ada-no-auto-case))
- :group 'ada)
-
-(defcustom ada-case-identifier 'ada-loose-case-word
- "Function to call to adjust the case of an Ada identifier.
-It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
-`ada-capitalize-word'."
- :type '(choice (const downcase-word)
- (const upcase-word)
- (const ada-capitalize-word)
- (const ada-loose-case-word)
- (const ada-no-auto-case))
- :group 'ada)
-
-(defcustom ada-clean-buffer-before-saving t
- "Non-nil means remove trailing spaces and untabify the buffer before saving."
- :type 'boolean :group 'ada)
-(make-obsolete-variable 'ada-clean-buffer-before-saving
- "it has no effect - use `write-file-functions' hook."
- "23.2")
-
-
-(defcustom ada-indent 3
- "Size of Ada indentation.
-
-An example is :
-procedure Foo is
-begin
->>>>>>>>>>null;"
- :type 'integer :group 'ada)
-
-(defcustom ada-indent-after-return t
- "Non-nil means automatically indent after RET or LFD."
- :type 'boolean :group 'ada)
-
-(defcustom ada-indent-align-comments t
- "Non-nil means align comments on previous line comments, if any.
-If nil, indentation is calculated as usual.
-Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
-
-For instance:
- A := 1; -- A multi-line comment
- -- aligned if `ada-indent-align-comments' is t"
- :type 'boolean :group 'ada)
-
-(defcustom ada-indent-comment-as-code t
- "Non-nil means indent comment lines as code.
-A nil value means do not auto-indent comments."
- :type 'boolean :group 'ada)
-
-(defcustom ada-indent-handle-comment-special nil
- "Non-nil if comment lines should be handled specially inside parenthesis.
-By default, if the line that contains the open parenthesis has some
-text following it, then the following lines will be indented in the
-same column as this text. This will not be true if the first line is
-a comment and `ada-indent-handle-comment-special' is t.
-
-type A is
- ( Value_1, -- common behavior, when not a comment
- Value_2);
-
-type A is
- ( -- `ada-indent-handle-comment-special' is nil
- Value_1,
- Value_2);
-
-type A is
- ( -- `ada-indent-handle-comment-special' is non-nil
- Value_1,
- Value_2);"
- :type 'boolean :group 'ada)
-
-(defcustom ada-indent-is-separate t
- "Non-nil means indent `is separate' or `is abstract' if on a single line."
- :type 'boolean :group 'ada)
-
-(defcustom ada-indent-record-rel-type 3
- "Indentation for `record' relative to `type' or `use'.
-
-An example is:
- type A is
- >>>>>>>>>>>record"
- :type 'integer :group 'ada)
-
-(defcustom ada-indent-renames ada-broken-indent
- "Indentation for renames relative to the matching function statement.
-If `ada-indent-return' is null or negative, the indentation is done relative to
-the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
-
-An example is:
- function A (B : Integer)
- return C;
- >>>renames Foo;"
- :type 'integer :group 'ada)
-
-(defcustom ada-indent-return 0
- "Indentation for `return' relative to the matching `function' statement.
-If `ada-indent-return' is null or negative, the indentation is done relative to
-the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
-
-An example is:
- function A (B : Integer)
- >>>>>return C;"
- :type 'integer :group 'ada)
-
-(defcustom ada-indent-to-open-paren t
- "Non-nil means indent according to the innermost open parenthesis."
- :type 'boolean :group 'ada)
-
-(defcustom ada-fill-comment-prefix "-- "
- "Text inserted in the first columns when filling a comment paragraph.
-Note: if you modify this variable, you will have to invoke `ada-mode'
-again to take account of the new value."
- :type 'string :group 'ada)
-
-(defcustom ada-fill-comment-postfix " --"
- "Text inserted at the end of each line when filling a comment paragraph.
-Used by `ada-fill-comment-paragraph-postfix'."
- :type 'string :group 'ada)
-
-(defcustom ada-label-indent -4
- "Number of columns to indent a label.
-
-An example is:
-procedure Foo is
-begin
->>>>Label:
-
-This is also used for <<..>> labels"
- :type 'integer :group 'ada)
-
-(defcustom ada-language-version 'ada95
- "Ada language version; one of `ada83', `ada95', `ada2005'."
- :type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada)
-
-(defcustom ada-move-to-declaration nil
- "Non-nil means `ada-move-to-start' moves to the subprogram declaration, not
to `begin'."
- :type 'boolean :group 'ada)
-
-(defcustom ada-popup-key '[down-mouse-3]
- "Key used for binding the contextual menu.
-If nil, no contextual menu is available."
- :type '(restricted-sexp :match-alternatives (stringp vectorp))
- :group 'ada)
-
-(defcustom ada-search-directories
- (append '(".")
- (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
- '("/usr/adainclude" "/usr/local/adainclude"
- "/opt/gnu/adainclude"))
- "Default list of directories to search for Ada files.
-See the description for the `ff-search-directories' variable. This variable
-is the initial value of `ada-search-directories-internal'."
- :type '(repeat (choice :tag "Directory"
- (const :tag "default" nil)
- (directory :format "%v")))
- :group 'ada)
-
-(defvar ada-search-directories-internal ada-search-directories
- "Internal version of `ada-search-directories'.
-Its value is the concatenation of the search path as read in the project file
-and the standard runtime location, and the value of the user-defined
-`ada-search-directories'.")
-
-(defcustom ada-stmt-end-indent 0
- "Number of columns to indent the end of a statement on a separate line.
-
-An example is:
- if A = B
- >>>>then"
- :type 'integer :group 'ada)
-
-(defcustom ada-tab-policy 'indent-auto
- "Control the behavior of the TAB key.
-Must be one of :
-`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the
line.
-`indent-auto' : use indentation functions in this file.
-`always-tab' : do `indent-relative'."
- :type '(choice (const indent-auto)
- (const indent-rigidly)
- (const always-tab))
- :group 'ada)
-
-(defcustom ada-use-indent ada-broken-indent
- "Indentation for the lines in a `use' statement.
-
-An example is:
- use Ada.Text_IO,
- >>>>Ada.Numerics;"
- :type 'integer :group 'ada)
-
-(defcustom ada-when-indent 3
- "Indentation for `when' relative to `exception' or `case'.
-
-An example is:
- case A is
- >>>>when B =>"
- :type 'integer :group 'ada)
-
-(defcustom ada-with-indent ada-broken-indent
- "Indentation for the lines in a `with' statement.
-
-An example is:
- with Ada.Text_IO,
- >>>>Ada.Numerics;"
- :type 'integer :group 'ada)
-
-(defcustom ada-which-compiler 'gnat
- "Name of the compiler to use.
-This will determine what features are made available through the Ada mode.
-The possible choices are:
-`gnat': Use Ada Core Technologies' GNAT compiler. Add some cross-referencing
- features.
-`generic': Use a generic compiler."
- :type '(choice (const gnat)
- (const generic))
- :group 'ada)
-
-
-;;; ---- end of user configurable variables
-
-
-(defvar ada-body-suffixes '(".adb")
- "List of possible suffixes for Ada body files.
-The extensions should include a `.' if needed.")
-
-(defvar ada-spec-suffixes '(".ads")
- "List of possible suffixes for Ada spec files.
-The extensions should include a `.' if needed.")
-
-(defvar ada-mode-menu (make-sparse-keymap "Ada")
- "Menu for Ada mode.")
-
-(defvar ada-mode-map (make-sparse-keymap)
- "Local keymap used for Ada mode.")
-
-(defvar ada-mode-extra-map (make-sparse-keymap)
- "Keymap used for non-standard keybindings.")
-
-;; default is C-c C-q because it's free in ada-mode-map
-(defvar ada-mode-extra-prefix "\C-c\C-q"
- "Prefix key to access `ada-mode-extra-map' functions.")
-
-(define-abbrev-table 'ada-mode-abbrev-table ()
- "Local abbrev table for Ada mode.")
-
-(eval-when-compile
- ;; These values are used in eval-when-compile expressions.
- (defconst ada-83-string-keywords
- '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
- "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
- "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
- "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
- "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
- "procedure" "raise" "range" "record" "rem" "renames" "return"
- "reverse" "select" "separate" "subtype" "task" "terminate" "then"
- "type" "use" "when" "while" "with" "xor")
- "List of Ada 83 keywords.
-Used to define `ada-*-keywords'.")
-
- (defconst ada-95-string-keywords
- '("abstract" "aliased" "protected" "requeue" "tagged" "until")
- "List of keywords new in Ada 95.
-Used to define `ada-*-keywords'.")
-
- (defconst ada-2005-string-keywords
- '("interface" "overriding" "synchronized")
- "List of keywords new in Ada 2005.
-Used to define `ada-*-keywords.'"))
-
-(defvar ada-ret-binding nil
- "Variable to save key binding of RET when casing is activated.")
-
-(defvar ada-case-exception '()
- "Alist of words (entities) that have special casing.")
-
-(defvar ada-case-exception-substring '()
- "Alist of substrings (entities) that have special casing.
-The substrings are detected for word constituent when the word
-is not itself in `ada-case-exception', and only for substrings that
-either are at the beginning or end of the word, or start after `_'.")
-
-(defvar ada-lfd-binding nil
- "Variable to save key binding of LFD when casing is activated.")
-
-(defvar ada-other-file-alist nil
- "Variable used by `find-file' to find the name of the other package.
-See `ff-other-file-alist'.")
-
-(defvar ada-align-list
- '(("[^:]\\(\\s-*\\):[^:]" 1 t)
- ("[^=]\\(\\s-+\\)=[^=]" 1 t)
- ("\\(\\s-*\\)use\\s-" 1)
- ("\\(\\s-*\\)--" 1))
- "Ada support for align.el <= 2.2.
-This variable provides regular expressions on which to align different lines.
-See `align-mode-alist' for more information.")
-
-(defvar ada-align-modes
- '((ada-declaration
- (regexp . "[^:]\\(\\s-*\\):[^:]")
- (valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode)))
- (ada-assignment
- (regexp . "[^=]\\(\\s-+\\)=[^=]")
- (valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode)))
- (ada-comment
- (regexp . "\\(\\s-*\\)--")
- (modes . '(ada-mode)))
- (ada-use
- (regexp . "\\(\\s-*\\)use\\s-")
- (valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode)))
- )
- "Ada support for align.el >= 2.8.
-This variable defines several rules to use to align different lines.")
-
-(defconst ada-align-region-separate
- (eval-when-compile
- (concat
- "^\\s-*\\($\\|\\("
- "begin\\|"
- "declare\\|"
- "else\\|"
- "end\\|"
- "exception\\|"
- "for\\|"
- "function\\|"
- "generic\\|"
- "if\\|"
- "is\\|"
- "procedure\\|"
- "record\\|"
- "return\\|"
- "type\\|"
- "when"
- "\\)\\>\\)"))
- "See the variable `align-region-separate' for more information.")
-
-;;; ---- Below are the regexp used in this package for parsing
-
-(defconst ada-83-keywords
- (eval-when-compile
- (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>"))
- "Regular expression matching Ada83 keywords.")
-
-(defconst ada-95-keywords
- (eval-when-compile
- (concat "\\<" (regexp-opt
- (append
- ada-95-string-keywords
- ada-83-string-keywords) t) "\\>"))
- "Regular expression matching Ada95 keywords.")
-
-(defconst ada-2005-keywords
- (eval-when-compile
- (concat "\\<" (regexp-opt
- (append
- ada-2005-string-keywords
- ada-83-string-keywords
- ada-95-string-keywords) t) "\\>"))
- "Regular expression matching Ada2005 keywords.")
-
-(defvar ada-keywords ada-2005-keywords
- "Regular expression matching Ada keywords.")
-;; FIXME: make this customizable
-
-(defconst ada-ident-re
- "[[:alpha:]]\\(?:[_[:alnum:]]\\)*"
- ;; [:alnum:] matches any multibyte word constituent, as well as
- ;; Latin-1 letters and numbers. This allows __ and trailing _;
- ;; someone (emacs bug#1919) proposed [^\W_] to fix that, but \W does
- ;; _not_ mean "not word constituent" inside a character alternative.
- "Regexp matching an Ada identifier.")
-
-(defconst ada-goto-label-re
- (concat "<<" ada-ident-re ">>")
- "Regexp matching a goto label.")
-
-(defconst ada-block-label-re
- (concat ada-ident-re "[ \t\n]*:[^=]")
- "Regexp matching a block label.
-Note that this also matches a variable declaration.")
-
-(defconst ada-label-re
- (concat "\\(?:" ada-block-label-re "\\)\\|\\(?:" ada-goto-label-re "\\)")
- "Regexp matching a goto or block label.")
-
-;; "with" needs to be included in the regexp, to match generic subprogram
parameters
-;; Similarly, we put '[not] overriding' on the same line with 'procedure' etc.
-(defvar ada-procedure-start-regexp
- (concat
- "^[ \t]*\\(with[ \t]+\\)?\\(\\(not[ \t]+\\)?overriding[
\t]+\\)?\\(procedure\\|function\\|task\\)[ \t\n]+"
-
- ;; subprogram name: operator ("[+/=*]")
- "\\("
- "\\(\"[^\"]+\"\\)"
-
- ;; subprogram name: name
- "\\|"
- "\\(\\(\\sw\\|[_.]\\)+\\)"
- "\\)")
- "Regexp matching Ada subprogram start.
-The actual start is at (match-beginning 4). The name is in (match-string 5).")
-
-(defconst ada-name-regexp
- "\\([a-zA-Z][a-zA-Z0-9_.']*[a-zA-Z0-9]\\)"
- "Regexp matching a fully qualified name (including attribute).")
-
-(defconst ada-package-start-regexp
- (concat "^[ \t]*\\(private[ \t]+\\)?\\(package\\)[ \t\n]+\\(body[ \t]*\\)?"
ada-name-regexp)
- "Regexp matching start of package.
-The package name is in (match-string 4).")
-
-(defconst ada-compile-goto-error-file-linenr-re
- "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"
- "Regexp matching filename:linenr[:column].")
-
-
-;;; ---- regexps for indentation functions
-
-(defvar ada-block-start-re
- (eval-when-compile
- (concat "\\<\\(" (regexp-opt '("begin" "declare" "else"
- "exception" "generic" "loop" "or"
- "private" "select" ))
- "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>"))
- "Regexp for keywords starting Ada blocks.")
-
-(defvar ada-end-stmt-re
- (eval-when-compile
- (concat "\\("
- ";" "\\|"
- "=>[ \t]*$" "\\|"
- "=>[ \t]*--.*$" "\\|"
- "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|"
- "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
- "loop" "private" "record" "select"
- "then abort" "then") t) "\\>" "\\|"
- "^[ \t]*" (regexp-opt '("function" "package" "procedure")
- t) "\\>\\(\\sw\\|[ \t_.]\\)+\\<is\\>"
"\\|"
- "^[ \t]*exception\\>"
- "\\)") )
- "Regexp of possible ends for a non-broken statement.
-A new statement starts after these.")
-
-(defvar ada-matching-start-re
- (eval-when-compile
- (concat "\\<"
- (regexp-opt
- '("end" "loop" "select" "begin" "case" "do" "declare"
- "if" "task" "package" "procedure" "function" "record"
"protected") t)
- "\\>"))
- "Regexp used in `ada-goto-matching-start'.")
-
-(defvar ada-loop-start-re
- "\\<\\(for\\|while\\|loop\\)\\>"
- "Regexp for the start of a loop.")
-
-(defvar ada-subprog-start-re
- (eval-when-compile
- (concat "\\<" (regexp-opt '("accept" "entry" "function" "overriding"
"package" "procedure"
- "protected" "task") t) "\\>"))
- "Regexp for the start of a subprogram.")
-
-(defvar ada-contextual-menu-on-identifier nil
- "Set to true when the right mouse button was clicked on an identifier.")
-
-(defvar ada-contextual-menu-last-point nil
- "Position of point just before displaying the menu.
-This is a list (point buffer).
-Since `ada-popup-menu' moves the point where the user clicked, the region
-is modified. Therefore no command from the menu knows what the user selected
-before displaying the contextual menu.
-To get the original region, restore the point to this position before
-calling `region-end' and `region-beginning'.
-Modify this variable if you want to restore the point to another position.")
-
-(easy-menu-define ada-contextual-menu nil
- "Menu to use when the user presses the right mouse button.
-The variable `ada-contextual-menu-on-identifier' will be set to t before
-displaying the menu if point was on an identifier."
- '("Ada"
- ["Goto Declaration/Body" ada-point-and-xref
- :included ada-contextual-menu-on-identifier]
- ["Goto Body" ada-point-and-xref-body
- :included ada-contextual-menu-on-identifier]
- ["Goto Previous Reference" ada-xref-goto-previous-reference]
- ["List References" ada-find-references
- :included ada-contextual-menu-on-identifier]
- ["List Local References" ada-find-local-references
- :included ada-contextual-menu-on-identifier]
- ["-" nil nil]
- ["Other File" ff-find-other-file]
- ["Goto Parent Unit" ada-goto-parent]))
-
-
-;;------------------------------------------------------------------
-;; Support for imenu (see imenu.el)
-;;------------------------------------------------------------------
-
-(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
-
-(defconst ada-imenu-subprogram-menu-re
- (concat "^[ \t]*\\(overriding[ \t]*\\)?\\(procedure\\|function\\)[ \t\n]+"
- "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
- ada-imenu-comment-re
- "\\)[ \t\n]*"
- "\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]"))
-
-(defvar ada-imenu-generic-expression
- (list
- (list nil ada-imenu-subprogram-menu-re 3)
- (list "*Specs*"
- (concat
- "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
- "\\("
- "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
- ada-imenu-comment-re "\\)";; parameter list or simple space
- "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?"
- "\\)?;") 2)
- '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[
\t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
- '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
- '("*Protected*"
- "^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[
\t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
- '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[
\t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1))
- "Imenu generic expression for Ada mode.
-See `imenu-generic-expression'. This variable will create several submenus for
-each type of entity that can be found in an Ada file.")
-
-
-;;------------------------------------------------------------
-;; Support for compile.el
-;;------------------------------------------------------------
-
-(defun ada-compile-mouse-goto-error ()
- "Mouse interface for `ada-compile-goto-error'."
- (interactive)
- (mouse-set-point last-input-event)
- (ada-compile-goto-error (point))
- )
-
-(defun ada-compile-goto-error (pos)
- "Replace `compile-goto-error' from compile.el.
-If POS is on a file and line location, go to this position. It adds
-to compile.el the capacity to go to a reference in an error message.
-For instance, on these lines:
- foo.adb:61:11: [...] in call to size declared at foo.ads:11
- foo.adb:61:11: [...] in call to local declared at line 20
-the 4 file locations can be clicked on and jumped to."
- (interactive "d")
- (goto-char pos)
-
- (skip-chars-backward "-a-zA-Z0-9_:./\\\\")
- (cond
- ;; special case: looking at a filename:line not at the beginning of a line
- ;; or a simple line reference "at line ..."
- ((and (not (bolp))
- (or (looking-at ada-compile-goto-error-file-linenr-re)
- (and
- (save-excursion
- (beginning-of-line)
- (looking-at ada-compile-goto-error-file-linenr-re))
- (save-excursion
- (if (looking-at "\\([0-9]+\\)") (backward-word-strictly 1))
- (looking-at "line \\([0-9]+\\)"))))
- )
- (let ((line (if (match-beginning 2) (match-string 2) (match-string 1)))
- (file (if (match-beginning 2) (match-string 1)
- (save-excursion (beginning-of-line)
- (looking-at
ada-compile-goto-error-file-linenr-re)
- (match-string 1))))
- (error-pos (point-marker))
- source)
-
- ;; set source marker
- (save-excursion
- (compilation-find-file (point-marker) (match-string 1) "./")
- (set-buffer file)
-
- (when (stringp line)
- (goto-char (point-min))
- (forward-line (1- (string-to-number line))))
-
- (setq source (point-marker)))
-
- (compilation-goto-locus error-pos source nil)
-
- ))
-
- ;; otherwise, default behavior
- (t
- (compile-goto-error))
- )
- (recenter))
-
-
-;;-------------------------------------------------------------------------
-;; Grammar related function
-;; The functions below work with the syntax class of the characters in an Ada
-;; buffer. Two syntax tables are created, depending on whether we want '_'
-;; to be considered as part of a word or not.
-;; Some characters may have multiple meanings depending on the context:
-;; - ' is either the beginning of a constant character or an attribute
-;; - # is either part of a based literal or a gnatprep statement.
-;; - " starts a string, but not if inside a constant character.
-;; - ( and ) should be ignored if inside a constant character.
-;; Thus their syntax property is changed automatically, and we can still use
-;; the standard Emacs functions for sexp (see `ada-in-string-p')
-;;
-;; On Emacs, this is done through the `syntax-table' text property. The
-;; corresponding action is applied automatically each time the buffer
-;; changes via syntax-propertize-function.
-;;
-;; on XEmacs, the `syntax-table' property does not exist and we have to use a
-;; slow advice to `parse-partial-sexp' to do the same thing.
-;; When executing parse-partial-sexp, we simply modify the strings before and
-;; after, so that the special constants '"', '(' and ')' do not interact
-;; with parse-partial-sexp.
-;; Note: this code is slow and needs to be rewritten as soon as something
-;; better is available on XEmacs.
-;;-------------------------------------------------------------------------
-
-(defvar ada-mode-syntax-table
- (let ((st (make-syntax-table)))
- ;; Define string brackets (`%' is alternative string bracket, but
- ;; almost never used as such and throws font-lock and indentation
- ;; off the track.)
- (modify-syntax-entry ?% "$" st)
- (modify-syntax-entry ?\" "\"" st)
-
- (modify-syntax-entry ?: "." st)
- (modify-syntax-entry ?\; "." st)
- (modify-syntax-entry ?& "." st)
- (modify-syntax-entry ?\| "." st)
- (modify-syntax-entry ?+ "." st)
- (modify-syntax-entry ?* "." st)
- (modify-syntax-entry ?/ "." st)
- (modify-syntax-entry ?= "." st)
- (modify-syntax-entry ?< "." st)
- (modify-syntax-entry ?> "." st)
- (modify-syntax-entry ?$ "." st)
- (modify-syntax-entry ?\[ "." st)
- (modify-syntax-entry ?\] "." st)
- (modify-syntax-entry ?\{ "." st)
- (modify-syntax-entry ?\} "." st)
- (modify-syntax-entry ?. "." st)
- (modify-syntax-entry ?\\ "." st)
- (modify-syntax-entry ?\' "." st)
-
- ;; A single hyphen is punctuation, but a double hyphen starts a comment.
- (modify-syntax-entry ?- ". 12" st)
-
- ;; See the comment above on grammar related function for the special
- ;; setup for '#'.
- (modify-syntax-entry ?# (if (featurep 'xemacs) "<" "$") st)
-
- ;; And \f and \n end a comment.
- (modify-syntax-entry ?\f "> " st)
- (modify-syntax-entry ?\n "> " st)
-
- ;; Define what belongs in Ada symbols.
- (modify-syntax-entry ?_ "_" st)
-
- ;; Define parentheses to match.
- (modify-syntax-entry ?\( "()" st)
- (modify-syntax-entry ?\) ")(" st)
- st)
- "Syntax table to be used for editing Ada source code.")
-
-(defvar ada-mode-symbol-syntax-table
- (let ((st (make-syntax-table ada-mode-syntax-table)))
- (modify-syntax-entry ?_ "w" st)
- st)
- "Syntax table for Ada, where `_' is a word constituent.")
-
-;; Support of special characters in XEmacs (see the comments at the beginning
-;; of the section on Grammar related functions).
-
-(if (featurep 'xemacs)
- (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
- "Handles special character constants and gnatprep statements."
- (let (change)
- (if (< to from)
- (let ((tmp from))
- (setq from to to tmp)))
- (save-excursion
- (goto-char from)
- (while (re-search-forward "'\\([(\")#]\\)'" to t)
- (setq change (cons (list (match-beginning 1)
- 1
- (match-string 1))
- change))
- (replace-match "'A'"))
- (goto-char from)
- (while (re-search-forward "\\(#[[:xdigit:]]*#\\)" to t)
- (setq change (cons (list (match-beginning 1)
- (length (match-string 1))
- (match-string 1))
- change))
- (replace-match (make-string (length (match-string 1)) ?@))))
- ad-do-it
- (save-excursion
- (while change
- (goto-char (caar change))
- (delete-char (cadar change))
- (insert (caddar change))
- (setq change (cdr change)))))))
-
-(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
- ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table
- ;; properties, and in some cases we even had to do it manually (in
- ;; `ada-after-change-function'). `ada-handle-syntax-table-properties'
- ;; decides which method to use.
-
-(defun ada-set-syntax-table-properties ()
- "Assign `syntax-table' properties in accessible part of buffer.
-In particular, character constants are said to be strings, #...#
-are treated as numbers instead of gnatprep comments."
- (let ((modified (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t))
- (remove-text-properties (point-min) (point-max) '(syntax-table nil))
- (goto-char (point-min))
- (while (re-search-forward
- ;; The following regexp was adapted from
- ;; `ada-font-lock-syntactic-keywords'.
- "^[
\t]*\\(#\\(?:if\\|else\\|elsif\\|end\\)\\)\\|[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)"
- nil t)
- (if (match-beginning 1)
- (put-text-property
- (match-beginning 1) (match-end 1) 'syntax-table '(11 . ?\n))
- (put-text-property
- (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?'))
- (put-text-property
- (match-beginning 3) (match-end 3) 'syntax-table '(7 . ?'))))
- (unless modified
- (restore-buffer-modified-p nil))))
-
-(defun ada-after-change-function (beg end _old-len)
- "Called when the region between BEG and END was changed in the buffer.
-OLD-LEN indicates what the length of the replaced text was."
- (save-excursion
- (save-restriction
- (let ((from (progn (goto-char beg) (line-beginning-position)))
- (to (progn (goto-char end) (line-end-position))))
- (narrow-to-region from to)
- (save-match-data
- (ada-set-syntax-table-properties))))))
-
-(defun ada-initialize-syntax-table-properties ()
- "Assign `syntax-table' properties in current buffer."
- (save-excursion
- (save-restriction
- (widen)
- (save-match-data
- (ada-set-syntax-table-properties))))
- (add-hook 'after-change-functions 'ada-after-change-function nil t))
-
-(defun ada-handle-syntax-table-properties ()
- "Handle `syntax-table' properties."
- (if font-lock-mode
- ;; `font-lock-mode' will take care of `syntax-table' properties.
- (remove-hook 'after-change-functions 'ada-after-change-function t)
- ;; Take care of `syntax-table' properties manually.
- (ada-initialize-syntax-table-properties)))
-
-) ;;(not (fboundp 'syntax-propertize))
-
-;;------------------------------------------------------------------
-;; Testing the grammatical context
-;;------------------------------------------------------------------
-
-(defsubst ada-in-comment-p (&optional parse-result)
- "Return t if inside a comment.
-If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
- (nth 4 (or parse-result
- (parse-partial-sexp
- (line-beginning-position) (point)))))
-
-(defsubst ada-in-string-p (&optional parse-result)
- "Return t if point is inside a string.
-If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
- (nth 3 (or parse-result
- (parse-partial-sexp
- (line-beginning-position) (point)))))
-
-(defsubst ada-in-string-or-comment-p (&optional parse-result)
- "Return t if inside a comment or string.
-If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
- (setq parse-result (or parse-result
- (parse-partial-sexp
- (line-beginning-position) (point))))
- (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
-
-(defsubst ada-in-numeric-literal-p ()
- "Return t if point is after a prefix of a numeric literal."
- (looking-back "\\([0-9]+#[[:xdigit:]_]+\\)" (line-beginning-position)))
-
-;;------------------------------------------------------------------
-;; Contextual menus
-;; The Ada mode comes with contextual menus, bound by default to the right
-;; mouse button.
-;; Add items to this menu by modifying `ada-contextual-menu'. Note that the
-;; variable `ada-contextual-menu-on-identifier' is set automatically to t
-;; if the mouse button was pressed on an identifier.
-;;------------------------------------------------------------------
-
-(defun ada-call-from-contextual-menu (function)
- "Execute FUNCTION when called from the contextual menu.
-It forces Emacs to change the cursor position."
- (interactive)
- (funcall function)
- (setq ada-contextual-menu-last-point
- (list (point) (current-buffer))))
-
-(defun ada-popup-menu (position)
- "Pops up a contextual menu, depending on where the user clicked.
-POSITION is the location the mouse was clicked on.
-Sets `ada-contextual-menu-last-point' to the current position before
-displaying the menu. When a function from the menu is called, the
-point is where the mouse button was clicked."
- (interactive "e")
-
- ;; declare this as a local variable, so that the function called
- ;; in the contextual menu does not hide the region in
- ;; transient-mark-mode.
- (let ((deactivate-mark nil))
- (setq ada-contextual-menu-last-point
- (list (point) (current-buffer)))
- (mouse-set-point last-input-event)
-
- (setq ada-contextual-menu-on-identifier
- (and (char-after)
- (or (= (char-syntax (char-after)) ?w)
- (= (char-after) ?_))
- (not (ada-in-string-or-comment-p))
- (save-excursion (skip-syntax-forward "w")
- (not (ada-after-keyword-p)))
- ))
- (if (fboundp 'popup-menu)
- (funcall (symbol-function 'popup-menu) ada-contextual-menu)
- (let (choice)
- (setq choice (x-popup-menu position ada-contextual-menu))
- (if choice
- (funcall (lookup-key ada-contextual-menu (vector (car choice)))))))
-
- (set-buffer (cadr ada-contextual-menu-last-point))
- (goto-char (car ada-contextual-menu-last-point))
- ))
-
-
-;;------------------------------------------------------------------
-;; Misc functions
-;;------------------------------------------------------------------
-
-;;;###autoload
-(defun ada-add-extensions (spec body)
- "Define SPEC and BODY as being valid extensions for Ada files.
-Going from body to spec with `ff-find-other-file' used these
-extensions.
-SPEC and BODY are two regular expressions that must match against
-the file name."
- (let* ((reg (concat (regexp-quote body) "$"))
- (tmp (assoc reg ada-other-file-alist)))
- (if tmp
- (setcdr tmp (list (cons spec (cadr tmp))))
- (add-to-list 'ada-other-file-alist (list reg (list spec)))))
-
- (let* ((reg (concat (regexp-quote spec) "$"))
- (tmp (assoc reg ada-other-file-alist)))
- (if tmp
- (setcdr tmp (list (cons body (cadr tmp))))
- (add-to-list 'ada-other-file-alist (list reg (list body)))))
-
- (add-to-list 'auto-mode-alist
- (cons (concat (regexp-quote spec) "\\'") 'ada-mode))
- (add-to-list 'auto-mode-alist
- (cons (concat (regexp-quote body) "\\'") 'ada-mode))
-
- (add-to-list 'ada-spec-suffixes spec)
- (add-to-list 'ada-body-suffixes body)
-
- ;; Support for speedbar (Specifies that we want to see these files in
- ;; speedbar)
- (if (fboundp 'speedbar-add-supported-extension)
- (progn
- (funcall (symbol-function 'speedbar-add-supported-extension)
- spec)
- (funcall (symbol-function 'speedbar-add-supported-extension)
- body))))
-
-(defvar ada-font-lock-syntactic-keywords) ; defined below
-
-;;;###autoload
-(define-derived-mode ada-mode prog-mode "Ada"
- "Ada mode is the major mode for editing Ada code."
-
- ;; Set the paragraph delimiters so that one can select a whole block
- ;; simply with M-h
- (set (make-local-variable 'paragraph-start) "[ \t\n\f]*$")
- (set (make-local-variable 'paragraph-separate) "[ \t\n\f]*$")
-
- ;; comment end must be set because it may hold a wrong value if
- ;; this buffer had been in another mode before. RE
- (set (make-local-variable 'comment-end) "")
-
- ;; used by autofill and indent-new-comment-line
- (set (make-local-variable 'comment-start-skip) "---*[ \t]*")
-
- ;; used by autofill to break a comment line and continue it on another line.
- ;; The reason we need this one is that the default behavior does not work
- ;; correctly with the definition of paragraph-start above when the comment
- ;; is right after a multi-line subprogram declaration (the comments are
- ;; aligned under the latest parameter, not under the declaration start).
- (set (make-local-variable 'comment-line-break-function)
- (lambda (&optional soft) (let ((fill-prefix nil))
- (indent-new-comment-line soft))))
-
- (set (make-local-variable 'indent-line-function)
- 'ada-indent-current-function)
-
- (set (make-local-variable 'comment-column) 40)
-
- ;; Emacs 20.3 defines a comment-padding to insert spaces between
- ;; the comment and the text. We do not want any, this is already
- ;; included in comment-start
- (unless (featurep 'xemacs)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'comment-padding) 0)
- (set (make-local-variable 'parse-sexp-lookup-properties) t))
-
- (setq case-fold-search t)
- (if (boundp 'imenu-case-fold-search)
- (setq imenu-case-fold-search t))
-
- (set (make-local-variable 'fill-paragraph-function)
- 'ada-fill-comment-paragraph)
-
- ;; Support for compile.el
- ;; We just substitute our own functions to go to the error.
- (add-hook 'compilation-mode-hook
- (lambda()
- ;; FIXME: This has global impact! -stef
- (define-key compilation-minor-mode-map [mouse-2]
- 'ada-compile-mouse-goto-error)
- (define-key compilation-minor-mode-map "\C-c\C-c"
- 'ada-compile-goto-error)
- (define-key compilation-minor-mode-map "\C-m"
- 'ada-compile-goto-error)))
-
- ;; font-lock support :
-
- (set (make-local-variable 'font-lock-defaults)
- '(ada-font-lock-keywords
- nil t
- ((?\_ . "w") (?# . "."))
- beginning-of-line))
-
- (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
- (set (make-local-variable 'syntax-propertize-function)
- (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords))
- (set (make-local-variable 'font-lock-syntactic-keywords)
- ada-font-lock-syntactic-keywords))
-
- ;; Set up support for find-file.el.
- (set (make-local-variable 'ff-other-file-alist)
- 'ada-other-file-alist)
- (set (make-local-variable 'ff-search-directories)
- 'ada-search-directories-internal)
- (setq ff-post-load-hook 'ada-set-point-accordingly
- ff-file-created-hook 'ada-make-body)
- (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in)
-
- (make-local-variable 'ff-special-constructs)
- (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair))
- (list
- ;; Top level child package declaration; go to the parent package.
- (cons (eval-when-compile
- (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
- "\\(body[ \t]+\\)?"
- "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[
\t\n]+is"))
- (lambda ()
- (ff-get-file
- ada-search-directories-internal
- (ada-make-filename-from-adaname (match-string 3))
- ada-spec-suffixes)))
-
- ;; A "separate" clause.
- (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
- (lambda ()
- (ff-get-file
- ada-search-directories-internal
- (ada-make-filename-from-adaname (match-string 1))
- ada-spec-suffixes)))
-
- ;; A "with" clause.
- (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
- (lambda ()
- (ff-get-file
- ada-search-directories-internal
- (ada-make-filename-from-adaname (match-string 1))
- ada-spec-suffixes)))
- ))
-
- ;; Support for outline-minor-mode
- (set (make-local-variable 'outline-regexp)
- "\\([
\t]*\\(procedure\\|function\\|package\\|if\\|while\\|for\\|declare\\|case\\|end\\|begin\\|loop\\)\\|--\\)")
- (set (make-local-variable 'outline-level) 'ada-outline-level)
-
- ;; Support for imenu : We want a sorted index
- (setq imenu-generic-expression ada-imenu-generic-expression)
-
- (setq imenu-sort-function 'imenu--sort-by-name)
-
- ;; Support for ispell : Check only comments
- (set (make-local-variable 'ispell-check-comments) 'exclusive)
-
- ;; Support for align
- (add-to-list 'align-dq-string-modes 'ada-mode)
- (add-to-list 'align-open-comment-modes 'ada-mode)
- (set (make-local-variable 'align-region-separate) ada-align-region-separate)
-
- ;; Exclude comments alone on line from alignment.
- (add-to-list 'align-exclude-rules-list
- '(ada-solo-comment
- (regexp . "^\\(\\s-*\\)--")
- (modes . '(ada-mode))))
- (add-to-list 'align-exclude-rules-list
- '(ada-solo-use
- (regexp . "^\\(\\s-*\\)\\<use\\>")
- (modes . '(ada-mode))))
-
- (setq ada-align-modes nil)
-
- (add-to-list 'ada-align-modes
- '(ada-declaration-assign
- (regexp . "[^:]\\(\\s-*\\):[^:]")
- (valid . (lambda() (not (ada-in-comment-p))))
- (repeat . t)
- (modes . '(ada-mode))))
- (add-to-list 'ada-align-modes
- '(ada-associate
- (regexp . "[^=]\\(\\s-*\\)=>")
- (valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode))))
- (add-to-list 'ada-align-modes
- '(ada-comment
- (regexp . "\\(\\s-*\\)--")
- (modes . '(ada-mode))))
- (add-to-list 'ada-align-modes
- '(ada-use
- (regexp . "\\(\\s-*\\)\\<use\\s-")
- (valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode))))
- (add-to-list 'ada-align-modes
- '(ada-at
- (regexp . "\\(\\s-+\\)at\\>")
- (modes . '(ada-mode))))
-
- (setq align-mode-rules-list ada-align-modes)
-
- ;; Set up the contextual menu
- (if ada-popup-key
- (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
-
- ;; Support for Abbreviations (the user still needs to "M-x abbrev-mode").
- (setq local-abbrev-table ada-mode-abbrev-table)
-
- ;; Support for which-function mode
- (set (make-local-variable 'which-func-functions) '(ada-which-function))
-
- ;; Support for indent-new-comment-line (Especially for XEmacs)
- (set (make-local-variable 'comment-multi-line) nil)
-
- ;; Support for add-log
- (set (make-local-variable 'add-log-current-defun-function)
- 'ada-which-function)
-
- (easy-menu-add ada-mode-menu ada-mode-map)
-
- (set (make-local-variable 'skeleton-further-elements)
- '((< '(backward-delete-char-untabify
- (min ada-indent (current-column))))))
- (add-hook 'skeleton-end-hook 'ada-adjust-case-skeleton nil t)
-
- ;; To be run after the hook, in case the user modified
- ;; ada-fill-comment-prefix
- (add-hook 'hack-local-variables-hook
- (lambda ()
- (set (make-local-variable 'comment-start)
- (or ada-fill-comment-prefix "-- "))
-
- ;; Run this after the hook to give the users a chance
- ;; to activate font-lock-mode.
-
- (unless (or (eval-when-compile (fboundp
'syntax-propertize-via-font-lock))
- (featurep 'xemacs))
- (ada-initialize-syntax-table-properties)
- (add-hook 'font-lock-mode-hook
- 'ada-handle-syntax-table-properties nil t))
-
- ;; FIXME: ada-language-version might be set in the mode
- ;; hook or it might even be set later on via file-local
- ;; vars, so ada-keywords should be set lazily.
- (cond ((eq ada-language-version 'ada83)
- (setq ada-keywords ada-83-keywords))
- ((eq ada-language-version 'ada95)
- (setq ada-keywords ada-95-keywords))
- ((eq ada-language-version 'ada2005)
- (setq ada-keywords ada-2005-keywords)))
-
- (if ada-auto-case
- (ada-activate-keys-for-case)))
- nil 'local))
-
-(defun ada-adjust-case-skeleton ()
- "Adjust the case of the text inserted by a skeleton."
- (save-excursion
- (let ((aa-end (point)))
- (ada-adjust-case-region
- (progn (goto-char (symbol-value 'beg)) (forward-word-strictly -1)
- (point))
- (goto-char aa-end)))))
-
-(defun ada-region-selected ()
- "Should we operate on an active region?"
- (if (fboundp 'use-region-p)
- (use-region-p)
- (region-active-p)))
-
-;;-----------------------------------------------------------------
-;; auto-casing
-;; Since Ada is case-insensitive, the Ada mode provides an extensive set of
-;; functions to auto-case identifiers, keywords, ...
-;; The basic rules for autocasing are defined through the variables
-;; `ada-case-attribute', `ada-case-keyword' and `ada-case-identifier'. These
-;; are references to the functions that will do the actual casing.
-;;
-;; However, in most cases, the user will want to define some exceptions to
-;; these casing rules. This is done through a list of files, that contain
-;; one word per line. These files are stored in `ada-case-exception-file'.
-;; For backward compatibility, this variable can also be a string.
-;;-----------------------------------------------------------------
-
-(defun ada-save-exceptions-to-file (file-name)
- "Save the casing exception lists to the file FILE-NAME.
-Casing exception lists are `ada-case-exception' and
`ada-case-exception-substring'."
- (find-file (expand-file-name file-name))
- (erase-buffer)
- (mapc (lambda (x) (insert (car x) "\n"))
- (sort (copy-sequence ada-case-exception)
- (lambda(a b) (string< (car a) (car b)))))
- (mapc (lambda (x) (insert "*" (car x) "\n"))
- (sort (copy-sequence ada-case-exception-substring)
- (lambda(a b) (string< (car a) (car b)))))
- (save-buffer)
- (kill-buffer nil)
- )
-
-(defun ada-create-case-exception (&optional word)
- "Define WORD as an exception for the casing system.
-If WORD is not given, then the current word in the buffer is used instead.
-The new word is added to the first file in `ada-case-exception-file'.
-The standard casing rules will no longer apply to this word."
- (interactive)
- (let ((file-name
- (cond ((stringp ada-case-exception-file)
- ada-case-exception-file)
- ((listp ada-case-exception-file)
- (car ada-case-exception-file))
- (t
- (error (concat "No exception file specified. "
- "See variable ada-case-exception-file"))))))
-
- (unless word
- (with-syntax-table ada-mode-symbol-syntax-table
- (save-excursion
- (skip-syntax-backward "w")
- (setq word (buffer-substring-no-properties
- (point) (save-excursion (forward-word-strictly 1)
- (point)))))))
-
- ;; Reread the exceptions file, in case it was modified by some other,
- (ada-case-read-exceptions-from-file file-name)
-
- ;; If the word is already in the list, even with a different casing
- ;; we simply want to replace it.
- (if (and (not (equal ada-case-exception '()))
- (assoc-string word ada-case-exception t))
- (setcar (assoc-string word ada-case-exception t) word)
- (add-to-list 'ada-case-exception (cons word t)))
-
- (ada-save-exceptions-to-file file-name)))
-
-(defun ada-create-case-exception-substring (&optional word)
- "Define the substring WORD as an exception for the casing system.
-If WORD is not given, then the current word in the buffer is used instead,
-or the selected region if any is active.
-The new word is added to the first file in `ada-case-exception-file'.
-When auto-casing a word, this substring will be special-cased, unless the
-word itself has a special casing."
- (interactive)
- (let ((file-name
- (cond ((stringp ada-case-exception-file)
- ada-case-exception-file)
- ((listp ada-case-exception-file)
- (car ada-case-exception-file))
- (t
- (error (concat "No exception file specified. "
- "See variable ada-case-exception-file"))))))
-
- ;; Find the substring to define as an exception. Order is: the parameter,
- ;; if any, or the selected region, or the word under the cursor
- (cond
- (word nil)
-
- ((ada-region-selected)
- (setq word (buffer-substring-no-properties
- (region-beginning) (region-end))))
-
- (t
- (let ((underscore-syntax (char-syntax ?_)))
- (unwind-protect
- (progn
- (modify-syntax-entry ?_ "." (syntax-table))
- (save-excursion
- (skip-syntax-backward "w")
- (setq word (buffer-substring-no-properties
- (point)
- (save-excursion (forward-word-strictly 1)
- (point))))))
- (modify-syntax-entry ?_ (make-string 1 underscore-syntax)
- (syntax-table))))))
-
- ;; Reread the exceptions file, in case it was modified by some other,
- (ada-case-read-exceptions-from-file file-name)
-
- ;; If the word is already in the list, even with a different casing
- ;; we simply want to replace it.
- (if (and (not (equal ada-case-exception-substring '()))
- (assoc-string word ada-case-exception-substring t))
- (setcar (assoc-string word ada-case-exception-substring t) word)
- (add-to-list 'ada-case-exception-substring (cons word t))
- )
-
- (ada-save-exceptions-to-file file-name)
-
- (message "%s" (concat "Defining " word " as a casing exception"))))
-
-(defun ada-case-read-exceptions-from-file (file-name)
- "Read the content of the casing exception file FILE-NAME."
- (if (file-readable-p (expand-file-name file-name))
- (let ((buffer (current-buffer)))
- (find-file (expand-file-name file-name))
- (set-syntax-table ada-mode-symbol-syntax-table)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
-
- ;; If the item is already in the list, even with an other casing,
- ;; do not add it again. This way, the user can easily decide which
- ;; priority should be applied to each casing exception
- (let ((word (buffer-substring-no-properties
- (point) (save-excursion (forward-word-strictly 1)
- (point)))))
-
- ;; Handling a substring ?
- (if (char-equal (string-to-char word) ?*)
- (progn
- (setq word (substring word 1))
- (unless (assoc-string word ada-case-exception-substring t)
- (add-to-list 'ada-case-exception-substring (cons word t))))
- (unless (assoc-string word ada-case-exception t)
- (add-to-list 'ada-case-exception (cons word t)))))
-
- (forward-line 1))
- (kill-buffer nil)
- (set-buffer buffer)))
- )
-
-(defun ada-case-read-exceptions ()
- "Read all the casing exception files from `ada-case-exception-file'."
- (interactive)
-
- ;; Reinitialize the casing exception list
- (setq ada-case-exception '()
- ada-case-exception-substring '())
-
- (cond ((stringp ada-case-exception-file)
- (ada-case-read-exceptions-from-file ada-case-exception-file))
-
- ((listp ada-case-exception-file)
- (mapcar 'ada-case-read-exceptions-from-file
- ada-case-exception-file))))
-
-(defun ada-adjust-case-substring ()
- "Adjust case of substrings in the previous word."
- (interactive)
- (let ((substrings ada-case-exception-substring)
- (max (point))
- (case-fold-search t)
- (underscore-syntax (char-syntax ?_))
- re)
-
- (save-excursion
- (forward-word -1)
-
- (unwind-protect
- (progn
- (modify-syntax-entry ?_ "." (syntax-table))
-
- (while substrings
- (setq re (concat "\\b" (regexp-quote (caar substrings)) "\\b"))
-
- (save-excursion
- (while (re-search-forward re max t)
- (replace-match (caar substrings) t)))
- (setq substrings (cdr substrings))
- )
- )
- (modify-syntax-entry ?_ (make-string 1 underscore-syntax)
(syntax-table)))
- )))
-
-(defun ada-adjust-case-identifier ()
- "Adjust case of the previous identifier.
-The auto-casing is done according to the value of `ada-case-identifier'
-and the exceptions defined in `ada-case-exception-file'."
- (interactive)
- (if (or (equal ada-case-exception '())
- (equal (char-after) ?_))
- (progn
- (funcall ada-case-identifier -1)
- (ada-adjust-case-substring))
-
- (progn
- (let ((end (point))
- (start (save-excursion (skip-syntax-backward "w")
- (point)))
- match)
- ;; If we have an exception, replace the word by the correct casing
- (if (setq match (assoc-string (buffer-substring start end)
- ada-case-exception t))
-
- (progn
- (delete-region start end)
- (insert (car match)))
-
- ;; Else simply re-case the word
- (funcall ada-case-identifier -1)
- (ada-adjust-case-substring))))))
-
-(defun ada-after-keyword-p ()
- "Return t if cursor is after a keyword that is not an attribute."
- (save-excursion
- (forward-word-strictly -1)
- (and (not (and (char-before)
- (or (= (char-before) ?_)
- (= (char-before) ?'))));; unless we have a _ or '
- (looking-at (concat ada-keywords "[^_]")))))
-
-(defun ada-adjust-case (&optional force-identifier)
- "Adjust the case of the word before the character just typed.
-If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier."
- (if (not (bobp))
- (progn
- (forward-char -1)
- (if (and (not (bobp))
- ;; or if at the end of a character constant
- (not (and (eq (following-char) ?')
- (eq (char-before (1- (point))) ?')))
- ;; or if the previous character was not part of a word
- (eq (char-syntax (char-before)) ?w)
- ;; if in a string or a comment
- (not (ada-in-string-or-comment-p))
- ;; if in a numeric literal
- (not (ada-in-numeric-literal-p))
- )
- (if (save-excursion
- (forward-word -1)
- (or (= (point) (point-min))
- (backward-char 1))
- (= (following-char) ?'))
- (funcall ada-case-attribute -1)
- (if (and
- (not force-identifier) ; (MH)
- (ada-after-keyword-p))
- (funcall ada-case-keyword -1)
- (ada-adjust-case-identifier))))
- (forward-char 1)
- ))
- )
-
-(defun ada-adjust-case-interactive (arg)
- "Adjust the case of the previous word, and process the character just typed.
-ARG is the prefix the user entered with \\[universal-argument]."
- (interactive "P")
-
- (if ada-auto-case
- (let ((lastk last-command-event))
-
- (with-syntax-table ada-mode-symbol-syntax-table
- (cond ((memq lastk '(?\n ?\r))
- ;; Horrible kludge.
- (insert " ")
- (ada-adjust-case)
- ;; horrible dekludge
- (delete-char -1)
- ;; some special keys and their bindings
- (cond
- ((eq lastk ?\n)
- (funcall ada-lfd-binding))
- ((eq lastk ?\r)
- (funcall ada-ret-binding))))
- ((eq lastk ?\C-i) (ada-tab))
- ;; Else just insert the character
- ((self-insert-command (prefix-numeric-value arg))))
- ;; if there is a keyword in front of the underscore
- ;; then it should be part of an identifier (MH)
- (if (eq lastk ?_)
- (ada-adjust-case t)
- (ada-adjust-case))))
-
- ;; Else, no auto-casing
- (cond
- ((eq last-command-event ?\n)
- (funcall ada-lfd-binding))
- ((eq last-command-event ?\r)
- (funcall ada-ret-binding))
- (t
- (self-insert-command (prefix-numeric-value arg))))))
-
-(defun ada-activate-keys-for-case ()
- ;; FIXME: Use post-self-insert-hook instead of changing key bindings.
- "Modify the key bindings for all the keys that should readjust the casing."
- (interactive)
- ;; Save original key-bindings to allow swapping ret/lfd
- ;; when casing is activated.
- ;; The 'or ...' is there to be sure that the value will not
- ;; be changed again when Ada mode is called more than once
- (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M")))
- (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j")))
-
- ;; Call case modifying function after certain keys.
- (mapcar (function (lambda(key) (define-key
- ada-mode-map
- (char-to-string key)
- 'ada-adjust-case-interactive)))
- '( ?` ?_ ?# ?% ?& ?* ?\( ?\) ?- ?= ?+
- ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r )))
-
-(defun ada-loose-case-word (&optional _arg)
- "Upcase first letter and letters following `_' in the following word.
-No other letter is modified.
-ARG is ignored, and is there for compatibility with `capitalize-word' only."
- (interactive)
- (save-excursion
- (let ((end (save-excursion (skip-syntax-forward "w") (point)))
- (first t))
- (skip-syntax-backward "w")
- (while (and (or first (search-forward "_" end t))
- (< (point) end))
- (and first
- (setq first nil))
- (insert-char (upcase (following-char)) 1)
- (delete-char 1)))))
-
-(defun ada-no-auto-case (&optional _arg)
- "Do nothing. ARG is ignored.
-This function can be used for the auto-casing variables in Ada mode, to
-adapt to unusual auto-casing schemes. Since it does nothing, you can for
-instance use it for `ada-case-identifier' if you don't want any special
-auto-casing for identifiers, whereas keywords have to be lower-cased.
-See also `ada-auto-case' to disable auto casing altogether."
- nil)
-
-(defun ada-capitalize-word (&optional _arg)
- "Upcase first letter and letters following `_', lower case other letters.
-ARG is ignored, and is there for compatibility with `capitalize-word' only."
- (interactive)
- (let ((end (save-excursion (skip-syntax-forward "w") (point)))
- (begin (save-excursion (skip-syntax-backward "w") (point))))
- (capitalize-region begin end)))
-
-(defun ada-adjust-case-region (from to)
- "Adjust the case of all words in the region between FROM and TO.
-Attention: This function might take very long for big regions!"
- (interactive "*r")
- (let ((begin nil)
- (end nil)
- (keywordp nil)
- (attribp nil))
- (message "Adjusting case ...")
- (with-syntax-table ada-mode-symbol-syntax-table
- (save-excursion
- (goto-char to)
- ;;
- ;; loop: look for all identifiers, keywords, and attributes
- ;;
- (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
- (setq end (match-end 1))
- (setq attribp
- (and (> (point) from)
- (save-excursion
- (forward-char -1)
- (setq attribp (looking-at "'.[^']")))))
- (or
- ;; do nothing if it is a string or comment
- (ada-in-string-or-comment-p)
- (progn
- ;;
- ;; get the identifier or keyword or attribute
- ;;
- (setq begin (point))
- (setq keywordp (looking-at ada-keywords))
- (goto-char end)
- ;;
- ;; casing according to user-option
- ;;
- (if attribp
- (funcall ada-case-attribute -1)
- (if keywordp
- (funcall ada-case-keyword -1)
- (ada-adjust-case-identifier)))
- (goto-char begin))))
- (message "Adjusting case ... Done")))))
-
-(defun ada-adjust-case-buffer ()
- "Adjust the case of all words in the whole buffer.
-ATTENTION: This function might take very long for big buffers!"
- (interactive "*")
- (ada-adjust-case-region (point-min) (point-max)))
-
-
-;;--------------------------------------------------------------
-;; Format Parameter Lists
-;; Some special algorithms are provided to indent the parameter lists in
-;; subprogram declarations. This is done in two steps:
-;; - First parses the parameter list. The returned list has the following
-;; format:
-;; ( (<Param_Name> in? out? access? <Type_Name> <Default_Expression>)
-;; ... )
-;; This is done in `ada-scan-paramlist'.
-;; - Delete and recreate the parameter list in function
-;; `ada-insert-paramlist'.
-;; Both steps are called from `ada-format-paramlist'.
-;; Note: Comments inside the parameter list are lost.
-;; The syntax has to be correct, or the reformatting will fail.
-;;--------------------------------------------------------------
-
-(defun ada-format-paramlist ()
- "Reformat the parameter list point is in."
- (interactive)
- (let ((begin nil)
- (end nil)
- (delend nil)
- (paramlist nil))
- (with-syntax-table ada-mode-symbol-syntax-table
-
- ;; check if really inside parameter list
- (or (ada-in-paramlist-p)
- (error "Not in parameter list"))
-
- ;; find start of current parameter-list
- (ada-search-ignore-string-comment
- (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
- (down-list 1)
- (backward-char 1)
- (setq begin (point))
-
- ;; find end of parameter-list
- (forward-sexp 1)
- (setq delend (point))
- (delete-char -1)
- (insert "\n")
-
- ;; find end of last parameter-declaration
- (forward-comment -1000)
- (setq end (point))
-
- ;; build a list of all elements of the parameter-list
- (setq paramlist (ada-scan-paramlist (1+ begin) end))
-
- ;; delete the original parameter-list
- (delete-region begin delend)
-
- ;; insert the new parameter-list
- (goto-char begin)
- (ada-insert-paramlist paramlist))))
-
-(defun ada-scan-paramlist (begin end)
- "Scan the parameter list found in between BEGIN and END.
-Return the equivalent internal parameter list."
- (let ((paramlist (list))
- (param (list))
- (notend t)
- (apos nil)
- (epos nil)
- (semipos nil)
- (match-cons nil))
-
- (goto-char begin)
-
- ;; loop until end of last parameter
- (while notend
-
- ;; find first character of parameter-declaration
- (ada-goto-next-non-ws)
- (setq apos (point))
-
- ;; find last character of parameter-declaration
- (if (setq match-cons
- (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
- (progn
- (setq epos (car match-cons))
- (setq semipos (cdr match-cons)))
- (setq epos end))
-
- ;; read name(s) of parameter(s)
- (goto-char apos)
- (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]")
-
- (setq param (list (match-string 1)))
- (ada-search-ignore-string-comment ":" nil epos t 'search-forward)
-
- ;; look for 'in'
- (setq apos (point))
- (setq param
- (append param
- (list
- (consp
- (ada-search-ignore-string-comment
- "in" nil epos t 'word-search-forward)))))
-
- ;; look for 'out'
- (goto-char apos)
- (setq param
- (append param
- (list
- (consp
- (ada-search-ignore-string-comment
- "out" nil epos t 'word-search-forward)))))
-
- ;; look for 'access'
- (goto-char apos)
- (setq param
- (append param
- (list
- (consp
- (ada-search-ignore-string-comment
- "access" nil epos t 'word-search-forward)))))
-
- ;; skip 'in'/'out'/'access'
- (goto-char apos)
- (ada-goto-next-non-ws)
- (while (looking-at "\\<\\(in\\|out\\|access\\)\\>")
- (forward-word-strictly 1)
- (ada-goto-next-non-ws))
-
- ;; read type of parameter
- ;; We accept spaces in the name, since some software like Rose
- ;; generates something like: "A : B 'Class"
- (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>")
- (setq param
- (append param
- (list (match-string 0))))
-
- ;; read default-expression, if there is one
- (goto-char (setq apos (match-end 0)))
- (setq param
- (append param
- (list
- (if (setq match-cons
- (ada-search-ignore-string-comment
- ":=" nil epos t 'search-forward))
- (buffer-substring (car match-cons) epos)
- nil))))
-
- ;; add this parameter-declaration to the list
- (setq paramlist (append paramlist (list param)))
-
- ;; check if it was the last parameter
- (if (eq epos end)
- (setq notend nil)
- (goto-char semipos))
- )
- (reverse paramlist)))
-
-(defun ada-insert-paramlist (paramlist)
- "Insert a formatted PARAMLIST in the buffer."
- (let ((i (length paramlist))
- (parlen 0)
- (typlen 0)
- (inp nil)
- (outp nil)
- (accessp nil)
- (column nil)
- (firstcol nil))
-
- ;; loop until last parameter
- (while (not (zerop i))
- (setq i (1- i))
-
- ;; get max length of parameter-name
- (setq parlen (max parlen (length (nth 0 (nth i paramlist)))))
-
- ;; get max length of type-name
- (setq typlen (max typlen (length (nth 4 (nth i paramlist)))))
-
- ;; is there any 'in' ?
- (setq inp (or inp (nth 1 (nth i paramlist))))
-
- ;; is there any 'out' ?
- (setq outp (or outp (nth 2 (nth i paramlist))))
-
- ;; is there any 'access' ?
- (setq accessp (or accessp (nth 3 (nth i paramlist))))
- )
-
- ;; does paramlist already start on a separate line ?
- (if (save-excursion
- (re-search-backward "^.\\|[^ \t]" nil t)
- (looking-at "^."))
- ;; yes => re-indent it
- (progn
- (ada-indent-current)
- (save-excursion
- (if (looking-at "\\(is\\|return\\)")
- (replace-match " \\1"))))
-
- ;; no => insert it where we are after removing any whitespace
- (fixup-whitespace)
- (save-excursion
- (cond
- ((looking-at "[ \t]*\\(\n\\|;\\)")
- (replace-match "\\1"))
- ((looking-at "[ \t]*\\(is\\|return\\)")
- (replace-match " \\1"))))
- (insert " "))
-
- (insert "(")
- (ada-indent-current)
-
- (setq firstcol (current-column))
- (setq i (length paramlist))
-
- ;; loop until last parameter
- (while (not (zerop i))
- (setq i (1- i))
- (setq column firstcol)
-
- ;; insert parameter-name, space and colon
- (insert (nth 0 (nth i paramlist)))
- (indent-to (+ column parlen 1))
- (insert ": ")
- (setq column (current-column))
-
- ;; insert 'in' or space
- (if (nth 1 (nth i paramlist))
- (insert "in ")
- (if (and
- (or inp
- accessp)
- (not (nth 3 (nth i paramlist))))
- (insert " ")))
-
- ;; insert 'out' or space
- (if (nth 2 (nth i paramlist))
- (insert "out ")
- (if (and
- (or outp
- accessp)
- (not (nth 3 (nth i paramlist))))
- (insert " ")))
-
- ;; insert 'access'
- (if (nth 3 (nth i paramlist))
- (insert "access "))
-
- (setq column (current-column))
-
- ;; insert type-name and, if necessary, space and default-expression
- (insert (nth 4 (nth i paramlist)))
- (if (nth 5 (nth i paramlist))
- (progn
- (indent-to (+ column typlen 1))
- (insert (nth 5 (nth i paramlist)))))
-
- ;; check if it was the last parameter
- (if (zerop i)
- (insert ")")
- ;; no => insert ';' and newline and indent
- (insert ";")
- (newline)
- (indent-to firstcol))
- )
-
- ;; if anything follows, except semicolon, newline, is or return
- ;; put it in a new line and indent it
- (unless (looking-at "[ \t]*\\(;\\|\n\\|is\\|return\\)")
- (ada-indent-newline-indent))
- ))
-
-
-
-;;;----------------------------------------------------------------
-;; Indentation Engine
-;; All indentations are indicated as a two-element string:
-;; - position of reference in the buffer
-;; - offset to indent from this position (can also be a symbol or a list
-;; that are evaluated)
-;; Thus the total indentation for a line is the column number of the reference
-;; position plus whatever value the evaluation of the second element provides.
-;; This mechanism is used so that the Ada mode can "explain" how the
-;; indentation was calculated, by showing which variables were used.
-;;
-;; The indentation itself is done in only one pass: first we try to guess in
-;; what context we are by looking at the following keyword or punctuation
-;; sign. If nothing remarkable is found, just try to guess the indentation
-;; based on previous lines.
-;;
-;; The relevant functions for indentation are:
-;; - `ada-indent-region': Re-indent a region of text
-;; - `ada-justified-indent-current': Re-indent the current line and shows the
-;; calculation that were done
-;; - `ada-indent-current': Re-indent the current line
-;; - `ada-get-current-indent': Calculate the indentation for the current line,
-;; based on the context (see above).
-;; - `ada-get-indent-*': Calculate the indentation in a specific context.
-;; For efficiency, these functions do not check they are in the correct
-;; context.
-;;;----------------------------------------------------------------
-
-(defun ada-indent-region (beg end)
- "Indent the region between BEG end END."
- (interactive "*r")
- (goto-char beg)
- (let ((block-done 0)
- (lines-remaining (count-lines beg end))
- (msg (format "%%4d out of %4d lines remaining ..."
- (count-lines beg end)))
- (endmark (copy-marker end)))
- ;; catch errors while indenting
- (while (< (point) endmark)
- (if (> block-done 39)
- (progn
- (setq lines-remaining (- lines-remaining block-done)
- block-done 0)
- (message msg lines-remaining)))
- (if (= (char-after) ?\n) nil
- (ada-indent-current))
- (forward-line 1)
- (setq block-done (1+ block-done)))
- (message "Indenting ... done")))
-
-(defun ada-indent-newline-indent ()
- "Indent the current line, insert a newline and then indent the new line."
- (interactive "*")
- (ada-indent-current)
- (newline)
- (ada-indent-current))
-
-(defun ada-indent-newline-indent-conditional ()
- "Insert a newline and indent it.
-The original line is re-indented if `ada-indent-after-return' is non-nil."
- (interactive "*")
- ;; If at end of buffer (entering brand new code), some indentation
- ;; fails. For example, a block label requires whitespace following
- ;; the : to be recognized. So we do the newline first, then
- ;; go back and indent the original line.
- (newline)
- (if ada-indent-after-return
- (progn
- (forward-char -1)
- (ada-indent-current)
- (forward-char 1)))
- (ada-indent-current))
-
-(defun ada-justified-indent-current ()
- "Indent the current line and explain how the calculation was done."
- (interactive)
-
- (let ((cur-indent (ada-indent-current)))
-
- (let ((line (save-excursion
- (goto-char (car cur-indent))
- (count-lines 1 (point)))))
-
- (if (equal (cdr cur-indent) '(0))
- (message (concat "same indentation as line " (number-to-string line)))
- (message "%s" (mapconcat (lambda(x)
- (cond
- ((symbolp x)
- (symbol-name x))
- ((numberp x)
- (number-to-string x))
- ((listp x)
- (concat "- " (symbol-name (cadr x))))
- ))
- (cdr cur-indent)
- " + "))))
- (save-excursion
- (goto-char (car cur-indent))
- (sit-for 1))))
-
-(defun ada-batch-reformat ()
- "Re-indent and re-case all the files found on the command line.
-This function should be used from the command line, with a
-command like:
- emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..."
-
- (while command-line-args-left
- (let ((source (car command-line-args-left)))
- (message "Formatting %s" source)
- (find-file source)
- (ada-indent-region (point-min) (point-max))
- (ada-adjust-case-buffer)
- (write-file source))
- (setq command-line-args-left (cdr command-line-args-left)))
- (message "Done")
- (kill-emacs 0))
-
-(defsubst ada-goto-previous-word ()
- "Move point to the beginning of the previous word of Ada code.
-Return the new position of point or nil if not found."
- (ada-goto-next-word t))
-
-(defun ada-indent-current ()
- "Indent current line as Ada code.
-Return the calculation that was done, including the reference point
-and the offset."
- (interactive)
- (let ((orgpoint (point-marker))
- cur-indent tmp-indent
- prev-indent)
-
- (unwind-protect
- (with-syntax-table ada-mode-symbol-syntax-table
-
- ;; This needs to be done here so that the advice is not always
- ;; activated (this might interact badly with other modes)
- (if (featurep 'xemacs)
- (ad-activate 'parse-partial-sexp t))
-
- (save-excursion
- (setq cur-indent
-
- ;; Not First line in the buffer ?
- (if (save-excursion (zerop (forward-line -1)))
- (progn
- (back-to-indentation)
- (ada-get-current-indent))
-
- ;; first line in the buffer
- (list (point-min) 0))))
-
- ;; Evaluate the list to get the column to indent to
- ;; prev-indent contains the column to indent to
- (if cur-indent
- (setq prev-indent (save-excursion (goto-char (car cur-indent))
- (current-column))
- tmp-indent (cdr cur-indent))
- (setq prev-indent 0 tmp-indent '()))
-
- (while (not (null tmp-indent))
- (cond
- ((numberp (car tmp-indent))
- (setq prev-indent (+ prev-indent (car tmp-indent))))
- (t
- (setq prev-indent (+ prev-indent (eval (car tmp-indent)))))
- )
- (setq tmp-indent (cdr tmp-indent)))
-
- ;; only re-indent if indentation is different then the current
- (if (= (save-excursion (back-to-indentation) (current-column))
prev-indent)
- nil
- (beginning-of-line)
- (delete-horizontal-space)
- (indent-to prev-indent))
- ;;
- ;; restore position of point
- ;;
- (goto-char orgpoint)
- (if (< (current-column) (current-indentation))
- (back-to-indentation)))
-
- (if (featurep 'xemacs)
- (ad-deactivate 'parse-partial-sexp)))
-
- cur-indent))
-
-(defun ada-get-current-indent ()
- "Return the indentation to use for the current line."
- (let (column
- pos
- match-cons
- result
- (orgpoint (save-excursion
- (beginning-of-line)
- (forward-comment -10000)
- (forward-line 1)
- (point))))
-
- (setq result
- (cond
-
- ;;-----------------------------
- ;; in open parenthesis, but not in parameter-list
- ;;-----------------------------
-
- ((and ada-indent-to-open-paren
- (not (ada-in-paramlist-p))
- (setq column (ada-in-open-paren-p)))
-
- ;; check if we have something like this (Table_Component_Type =>
- ;; Source_File_Record)
- (save-excursion
-
- ;; Align the closing parenthesis on the opening one
- (if (= (following-char) ?\))
- (save-excursion
- (goto-char column)
- (skip-chars-backward " \t")
- (list (1- (point)) 0))
-
- (if (and (skip-chars-backward " \t")
- (= (char-before) ?\n)
- (not (forward-comment -10000))
- (= (char-before) ?>))
- ;; ??? Could use a different variable
- (list column 'ada-broken-indent)
-
- ;; We want all continuation lines to be indented the same
- ;; (ada-broken-line from the opening parenthesis. However, in
- ;; parameter list, each new parameter should be indented at the
- ;; column as the opening parenthesis.
-
- ;; A special case to handle nested boolean expressions, as in
- ;; ((B
- ;; and then C) -- indented by ada-broken-indent
- ;; or else D) -- indenting this line.
- ;; ??? This is really a hack, we should have a proper way to go to
- ;; ??? the beginning of the statement
-
- (if (= (char-before) ?\))
- (backward-sexp))
-
- (if (memq (char-before) '(?, ?\; ?\( ?\)))
- (list column 0)
- (list column 'ada-continuation-indent)
- )))))
-
- ;;---------------------------
- ;; at end of buffer
- ;;---------------------------
-
- ((not (char-after))
- (ada-indent-on-previous-lines nil orgpoint orgpoint))
-
- ;;---------------------------
- ;; starting with e
- ;;---------------------------
-
- ((= (downcase (char-after)) ?e)
- (cond
-
- ;; ------- end ------
-
- ((looking-at "end\\>")
- (let ((label 0)
- limit)
- (save-excursion
- (ada-goto-matching-start 1)
-
- ;;
- ;; found 'loop' => skip back to 'while' or 'for'
- ;; if 'loop' is not on a separate line
- ;; Stop the search for 'while' and 'for' when a ';' is encountered.
- ;;
- (if (save-excursion
- (beginning-of-line)
- (looking-at ".+\\<loop\\>"))
- (progn
- (save-excursion
- (setq limit (car (ada-search-ignore-string-comment ";" t))))
- (if (save-excursion
- (and
- (setq match-cons
- (ada-search-ignore-string-comment
ada-loop-start-re t limit))
- (not (looking-at "\\<loop\\>"))))
- (progn
- (goto-char (car match-cons))
- (save-excursion
- (back-to-indentation)
- (if (looking-at ada-block-label-re)
- (setq label (- ada-label-indent))))))))
-
- ;; found 'record' =>
- ;; if the keyword is found at the beginning of a line (or just
- ;; after limited, we indent on it, otherwise we indent on the
- ;; beginning of the type declaration)
- ;; type A is (B : Integer;
- ;; C : Integer) is record
- ;; end record; -- This is badly indented otherwise
- (if (looking-at "record")
- (if (save-excursion
- (beginning-of-line)
- (looking-at "^[ \t]*\\(record\\|limited record\\)"))
- (list (save-excursion (back-to-indentation) (point)) 0)
- (list (save-excursion
- (car (ada-search-ignore-string-comment "\\<type\\>"
t)))
- 0))
-
- ;; Else keep the same indentation as the beginning statement
- (list (+ (save-excursion (back-to-indentation) (point)) label)
0)))))
-
- ;; ------ exception ----
-
- ((looking-at "exception\\>")
- (save-excursion
- (ada-goto-matching-start 1)
- (list (save-excursion (back-to-indentation) (point)) 0)))
-
- ;; else
-
- ((looking-at "else\\>")
- (if (save-excursion (ada-goto-previous-word)
- (looking-at "\\<or\\>"))
- (ada-indent-on-previous-lines nil orgpoint orgpoint)
- (save-excursion
- (ada-goto-matching-start 1 nil t)
- (list (progn (back-to-indentation) (point)) 0))))
-
- ;; elsif
-
- ((looking-at "elsif\\>")
- (save-excursion
- (ada-goto-matching-start 1 nil t)
- (list (progn (back-to-indentation) (point)) 0)))
-
- ))
-
- ;;---------------------------
- ;; starting with w (when)
- ;;---------------------------
-
- ((and (= (downcase (char-after)) ?w)
- (looking-at "when\\>"))
- (save-excursion
- (ada-goto-matching-start 1)
- (list (save-excursion (back-to-indentation) (point))
- 'ada-when-indent)))
-
- ;;---------------------------
- ;; starting with t (then)
- ;;---------------------------
-
- ((and (= (downcase (char-after)) ?t)
- (looking-at "then\\>"))
- (if (save-excursion (ada-goto-previous-word)
- (looking-at "and\\>"))
- (ada-indent-on-previous-lines nil orgpoint orgpoint)
- (save-excursion
- ;; Select has been added for the statement: "select ... then abort"
- (ada-search-ignore-string-comment
- "\\<\\(elsif\\|if\\|select\\)\\>" t nil)
- (list (progn (back-to-indentation) (point))
- 'ada-stmt-end-indent))))
-
- ;;---------------------------
- ;; starting with l (loop)
- ;;---------------------------
-
- ((and (= (downcase (char-after)) ?l)
- (looking-at "loop\\>"))
- (setq pos (point))
- (save-excursion
- (goto-char (match-end 0))
- (ada-goto-stmt-start)
- (if (looking-at "\\<\\(loop\\|if\\)\\>")
- (ada-indent-on-previous-lines nil orgpoint orgpoint)
- (unless (looking-at ada-loop-start-re)
- (ada-search-ignore-string-comment ada-loop-start-re
- nil pos))
- (if (looking-at "\\<loop\\>")
- (ada-indent-on-previous-lines nil orgpoint orgpoint)
- (list (progn (back-to-indentation) (point))
'ada-stmt-end-indent)))))
-
- ;;----------------------------
- ;; starting with l (limited) or r (record)
- ;;----------------------------
-
- ((or (and (= (downcase (char-after)) ?l)
- (looking-at "limited\\>"))
- (and (= (downcase (char-after)) ?r)
- (looking-at "record\\>")))
-
- (save-excursion
- (ada-search-ignore-string-comment
- "\\<\\(type\\|use\\)\\>" t nil)
- (if (looking-at "\\<use\\>")
- (ada-search-ignore-string-comment "for" t nil nil
- 'word-search-backward))
- (list (progn (back-to-indentation) (point))
- 'ada-indent-record-rel-type)))
-
- ;;---------------------------
- ;; starting with b (begin)
- ;;---------------------------
-
- ((and (= (downcase (char-after)) ?b)
- (looking-at "begin\\>"))
- (save-excursion
- (if (ada-goto-decl-start t)
- (list (progn (back-to-indentation) (point)) 0)
- (ada-indent-on-previous-lines nil orgpoint orgpoint))))
-
- ;;---------------------------
- ;; starting with i (is)
- ;;---------------------------
-
- ((and (= (downcase (char-after)) ?i)
- (looking-at "is\\>"))
-
- (if (and ada-indent-is-separate
- (save-excursion
- (goto-char (match-end 0))
- (ada-goto-next-non-ws (point-at-eol))
- (looking-at "\\<abstract\\>\\|\\<separate\\>")))
- (save-excursion
- (ada-goto-stmt-start)
- (list (progn (back-to-indentation) (point)) 'ada-indent))
- (save-excursion
- (ada-goto-stmt-start)
- (if (looking-at "\\<overriding\\|package\\|procedure\\|function\\>")
- (list (progn (back-to-indentation) (point)) 0)
- (list (progn (back-to-indentation) (point)) 'ada-indent)))))
-
- ;;---------------------------
- ;; starting with r (return, renames)
- ;;---------------------------
-
- ((and (= (downcase (char-after)) ?r)
- (looking-at "re\\(turn\\|names\\)\\>"))
-
- (save-excursion
- (let ((var 'ada-indent-return))
- ;; If looking at a renames, skip the 'return' statement too
- (if (looking-at "renames")
- (let (pos)
- (save-excursion
- (setq pos (ada-search-ignore-string-comment ";\\|return\\>"
t)))
- (if (and pos
- (= (downcase (char-after (car pos))) ?r))
- (goto-char (car pos)))
- (setq var 'ada-indent-renames)))
-
- (forward-comment -1000)
- (if (= (char-before) ?\))
- (forward-sexp -1)
- (forward-word-strictly -1))
-
- ;; If there is a parameter list, and we have a function declaration
- ;; or access to subprogram declaration
- (let ((num-back 1))
- (if (and (= (following-char) ?\()
- (save-excursion
- (or (progn
- (backward-word-strictly 1)
- (looking-at "\\(function\\|procedure\\)\\>"))
- (progn
- (backward-word-strictly 1)
- (setq num-back 2)
- (looking-at "\\(function\\|procedure\\)\\>")))))
-
- ;; The indentation depends of the value of ada-indent-return
- (if (<= (eval var) 0)
- (list (point) (list '- var))
- (list (progn (backward-word-strictly num-back) (point))
- var))
-
- ;; Else there is no parameter list, but we have a function
- ;; Only do something special if the user want to indent
- ;; relative to the "function" keyword
- (if (and (> (eval var) 0)
- (save-excursion (forward-word-strictly -1)
- (looking-at "function\\>")))
- (list (progn (forward-word-strictly -1) (point)) var)
-
- ;; Else...
- (ada-indent-on-previous-lines nil orgpoint orgpoint)))))))
-
- ;;--------------------------------
- ;; starting with 'o' or 'p'
- ;; 'or' as statement-start
- ;; 'private' as statement-start
- ;;--------------------------------
-
- ((and (or (= (downcase (char-after)) ?o)
- (= (downcase (char-after)) ?p))
- (or (ada-looking-at-semi-or)
- (ada-looking-at-semi-private)))
- (save-excursion
- ;; ??? Wasn't this done already in ada-looking-at-semi-or ?
- (ada-goto-matching-start 1)
- (list (progn (back-to-indentation) (point)) 0)))
-
- ;;--------------------------------
- ;; starting with 'd' (do)
- ;;--------------------------------
-
- ((and (= (downcase (char-after)) ?d)
- (looking-at "do\\>"))
- (save-excursion
- (ada-goto-stmt-start)
- (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))
-
- ;;--------------------------------
- ;; starting with '-' (comment)
- ;;--------------------------------
-
- ((= (char-after) ?-)
- (if ada-indent-comment-as-code
-
- ;; Indent comments on previous line comments if required
- ;; We must use a search-forward (even if the code is more complex),
- ;; since we want to find the beginning of the comment.
- (let (pos)
-
- (if (and ada-indent-align-comments
- (save-excursion
- (forward-line -1)
- (beginning-of-line)
- (while (and (not pos)
- (search-forward "--" (point-at-eol) t))
- (unless (ada-in-string-p)
- (setq pos (point))))
- pos))
- (list (- pos 2) 0)
-
- ;; Else always on previous line
- (ada-indent-on-previous-lines nil orgpoint orgpoint)))
-
- ;; Else same indentation as the previous line
- (list (save-excursion (back-to-indentation) (point)) 0)))
-
- ;;--------------------------------
- ;; starting with '#' (preprocessor line)
- ;;--------------------------------
-
- ((and (= (char-after) ?#)
- (equal ada-which-compiler 'gnat)
- (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)"))
- (list (point-at-bol) 0))
-
- ;;--------------------------------
- ;; starting with ')' (end of a parameter list)
- ;;--------------------------------
-
- ((and (not (eobp)) (= (char-after) ?\)))
- (save-excursion
- (forward-char 1)
- (backward-sexp 1)
- (list (point) 0)))
-
- ;;---------------------------------
- ;; new/abstract/separate
- ;;---------------------------------
-
- ((looking-at "\\(new\\|abstract\\|separate\\)\\>")
- (ada-indent-on-previous-lines nil orgpoint orgpoint))
-
- ;;---------------------------------
- ;; package/function/procedure
- ;;---------------------------------
-
- ((and (or (= (downcase (char-after)) ?p) (= (downcase (char-after)) ?f))
- (looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))
- (save-excursion
- ;; Go up until we find either a generic section, or the end of the
- ;; previous subprogram/package, or 'overriding' for this
function/procedure
- (let (found)
- (while (and (not found)
- (ada-search-ignore-string-comment
-
"\\<\\(generic\\|end\\|begin\\|overriding\\|package\\|procedure\\|function\\)\\>"
t))
-
- ;; avoid "with procedure"... in generic parts
- (save-excursion
- (forward-word-strictly -1)
- (setq found (not (looking-at "with"))))))
-
- (cond
- ((looking-at "\\<generic\\|overriding\\>")
- (list (progn (back-to-indentation) (point)) 0))
-
- (t
- (ada-indent-on-previous-lines nil orgpoint orgpoint)))))
-
- ;;---------------------------------
- ;; label
- ;;---------------------------------
-
- ((looking-at ada-label-re)
- (if (ada-in-decl-p)
- ;; ada-block-label-re matches variable declarations
- (ada-indent-on-previous-lines nil orgpoint orgpoint)
- (append (ada-indent-on-previous-lines nil orgpoint orgpoint)
- '(ada-label-indent))))
-
- ))
-
- ;;---------------------------------
- ;; Other syntaxes
- ;;---------------------------------
- (or result (ada-indent-on-previous-lines nil orgpoint orgpoint))))
-
-(defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos)
- "Calculate the indentation for the new line after ORGPOINT.
-The result list is based on the previous lines in the buffer.
-If NOMOVE is nil, moves point to the beginning of the current statement.
-if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
- (if initial-pos
- (goto-char initial-pos))
- (let ((oldpoint (point)))
-
- ;; Is inside a parameter-list ?
- (if (ada-in-paramlist-p)
- (ada-get-indent-paramlist)
-
- ;; Move to beginning of current statement. If already at a
- ;; statement start, move to beginning of enclosing statement.
- (unless nomove
- (ada-goto-stmt-start t))
-
- ;; no beginning found => don't change indentation
- (if (and (eq oldpoint (point))
- (not nomove))
- (ada-get-indent-nochange)
-
- (cond
- ;;
- ((and
- ada-indent-to-open-paren
- (ada-in-open-paren-p))
- (ada-get-indent-open-paren))
- ;;
- ((looking-at "end\\>")
- (ada-get-indent-end orgpoint))
- ;;
- ((looking-at ada-loop-start-re)
- (ada-get-indent-loop orgpoint))
- ;;
- ((looking-at ada-subprog-start-re)
- (ada-get-indent-subprog orgpoint))
- ;;
- ((looking-at ada-block-start-re)
- (ada-get-indent-block-start orgpoint))
- ;;
- ((looking-at ada-block-label-re) ; also variable declaration
- (ada-get-indent-block-label orgpoint))
- ;;
- ((looking-at ada-goto-label-re)
- (ada-get-indent-goto-label orgpoint))
- ;;
- ((looking-at "\\(sub\\)?type\\>")
- (ada-get-indent-type orgpoint))
- ;;
- ;; "then" has to be included in the case of "select...then abort"
- ;; statements, since (goto-stmt-start) at the beginning of
- ;; the current function would leave the cursor on that position
- ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\>")
- (ada-get-indent-if orgpoint))
- ;;
- ((looking-at "case\\>")
- (ada-get-indent-case orgpoint))
- ;;
- ((looking-at "when\\>")
- (ada-get-indent-when orgpoint))
- ;;
- ((looking-at "separate\\>")
- (ada-get-indent-nochange))
- ;;
- ((looking-at "with\\>\\|use\\>")
- ;; Are we still in that statement, or are we in fact looking at
- ;; the previous one ?
- (if (save-excursion (search-forward ";" oldpoint t))
- (list (progn (back-to-indentation) (point)) 0)
- (list (point) (if (looking-at "with")
- 'ada-with-indent
- 'ada-use-indent))))
- ;;
- (t
- (ada-get-indent-noindent orgpoint)))))
- ))
-
-(defun ada-get-indent-open-paren ()
- "Calculate the indentation when point is behind an unclosed parenthesis."
- (list (ada-in-open-paren-p) 0))
-
-(defun ada-get-indent-nochange ()
- "Return the current indentation of the previous line."
- (save-excursion
- (forward-line -1)
- (back-to-indentation)
- (list (point) 0)))
-
-(defun ada-get-indent-paramlist ()
- "Calculate the indentation when point is inside a parameter list."
- (save-excursion
- (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
- (cond
- ;; in front of the first parameter
- ((= (char-after) ?\()
- (goto-char (match-end 0))
- (list (point) 0))
-
- ;; in front of another parameter
- ((= (char-after) ?\;)
- (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
- (ada-goto-next-non-ws)
- (list (point) 0))
-
- ;; After an affectation (default parameter value in subprogram
- ;; declaration)
- ((and (= (following-char) ?=) (= (preceding-char) ?:))
- (back-to-indentation)
- (list (point) 'ada-broken-indent))
-
- ;; inside a parameter declaration
- (t
- (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
- (ada-goto-next-non-ws)
- (list (point) 'ada-broken-indent)))))
-
-(defun ada-get-indent-end (orgpoint)
- "Calculate the indentation when point is just before an end statement.
-ORGPOINT is the limit position used in the calculation."
- (let ((defun-name nil)
- (indent nil))
-
- ;; is the line already terminated by ';' ?
- (if (save-excursion
- (ada-search-ignore-string-comment ";" nil orgpoint nil
- 'search-forward))
-
- ;; yes, look what's following 'end'
- (progn
- (forward-word-strictly 1)
- (ada-goto-next-non-ws)
- (cond
- ;;
- ;; loop/select/if/case/return
- ;;
- ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|return\\)\\>")
- (save-excursion (ada-check-matching-start (match-string 0)))
- (list (save-excursion (back-to-indentation) (point)) 0))
-
- ;;
- ;; record
- ;;
- ((looking-at "\\<record\\>")
- (save-excursion
- (ada-check-matching-start (match-string 0))
- ;; we are now looking at the matching "record" statement
- (forward-word-strictly 1)
- (ada-goto-stmt-start)
- ;; now on the matching type declaration, or use clause
- (unless (looking-at "\\(for\\|type\\)\\>")
- (ada-search-ignore-string-comment "\\<type\\>" t))
- (list (progn (back-to-indentation) (point)) 0)))
- ;;
- ;; a named block end
- ;;
- ((looking-at ada-ident-re)
- (setq defun-name (match-string 0))
- (save-excursion
- (ada-goto-matching-start 0)
- (ada-check-defun-name defun-name))
- (list (progn (back-to-indentation) (point)) 0))
- ;;
- ;; a block-end without name
- ;;
- ((= (char-after) ?\;)
- (save-excursion
- (ada-goto-matching-start 0)
- (if (looking-at "\\<begin\\>")
- (progn
- (setq indent (list (point) 0))
- (if (ada-goto-decl-start t)
- (list (progn (back-to-indentation) (point)) 0)
- indent))
- (list (progn (back-to-indentation) (point)) 0)
- )))
- ;;
- ;; anything else - should maybe signal an error ?
- ;;
- (t
- (list (save-excursion (back-to-indentation) (point))
- 'ada-broken-indent))))
-
- (list (save-excursion (back-to-indentation) (point))
- 'ada-broken-indent))))
-
-(defun ada-get-indent-case (orgpoint)
- "Calculate the indentation when point is just before a case statement.
-ORGPOINT is the limit position used in the calculation."
- (let ((match-cons nil)
- (opos (point)))
- (cond
- ;;
- ;; case..is..when..=>
- ;;
- ((save-excursion
- (setq match-cons (and
- ;; the `=>' must be after the keyword `is'.
- (ada-search-ignore-string-comment
- "is" nil orgpoint nil 'word-search-forward)
- (ada-search-ignore-string-comment
- "[ \t\n]+=>" nil orgpoint))))
- (save-excursion
- (goto-char (car match-cons))
- (unless (ada-search-ignore-string-comment "when" t opos)
- (error "Missing `when' between `case' and `=>'"))
- (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))
- ;;
- ;; case..is..when
- ;;
- ((save-excursion
- (setq match-cons (ada-search-ignore-string-comment
- "when" nil orgpoint nil 'word-search-forward)))
- (goto-char (cdr match-cons))
- (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
- ;;
- ;; case..is
- ;;
- ((save-excursion
- (setq match-cons (ada-search-ignore-string-comment
- "is" nil orgpoint nil 'word-search-forward)))
- (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent))
- ;;
- ;; incomplete case
- ;;
- (t
- (list (save-excursion (back-to-indentation) (point))
- 'ada-broken-indent)))))
-
-(defun ada-get-indent-when (orgpoint)
- "Calculate the indentation when point is just before a when statement.
-ORGPOINT is the limit position used in the calculation."
- (let ((cur-indent (save-excursion (back-to-indentation) (point))))
- (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint)
- (list cur-indent 'ada-indent)
- (list cur-indent 'ada-broken-indent))))
-
-(defun ada-get-indent-if (orgpoint)
- "Calculate the indentation when point is just before an if statement.
-ORGPOINT is the limit position used in the calculation."
- (let ((cur-indent (save-excursion (back-to-indentation) (point)))
- (match-cons nil))
- ;;
- ;; Move to the correct then (ignore all "and then")
- ;;
- (while (and (setq match-cons (ada-search-ignore-string-comment
- "\\<\\(then\\|and[ \t]*then\\)\\>"
- nil orgpoint))
- (= (downcase (char-after (car match-cons))) ?a)))
- ;; If "then" was found (we are looking at it)
- (if match-cons
- (progn
- ;;
- ;; 'then' first in separate line ?
- ;; => indent according to 'then',
- ;; => else indent according to 'if'
- ;;
- (if (save-excursion
- (back-to-indentation)
- (looking-at "\\<then\\>"))
- (setq cur-indent (save-excursion (back-to-indentation) (point))))
- ;; skip 'then'
- (forward-word-strictly 1)
- (list cur-indent 'ada-indent))
-
- (list cur-indent 'ada-broken-indent))))
-
-(defun ada-get-indent-block-start (orgpoint)
- "Calculate the indentation when point is at the start of a block.
-ORGPOINT is the limit position used in the calculation."
- (let ((pos nil))
- (cond
- ((save-excursion
- (forward-word-strictly 1)
- (setq pos (ada-goto-next-non-ws orgpoint)))
- (goto-char pos)
- (save-excursion
- (ada-indent-on-previous-lines t orgpoint)))
-
- ;; Special case for record types, for instance for:
- ;; type A is (B : Integer;
- ;; C : Integer) is record
- ;; null; -- This is badly indented otherwise
- ((looking-at "record")
-
- ;; If record is at the beginning of the line, indent from there
- (if (save-excursion
- (beginning-of-line)
- (looking-at "^[ \t]*\\(record\\|limited record\\)"))
- (list (save-excursion (back-to-indentation) (point)) 'ada-indent)
-
- ;; else indent relative to the type command
- (list (save-excursion
- (car (ada-search-ignore-string-comment "\\<type\\>" t)))
- 'ada-indent)))
-
- ;; Special case for label:
- ((looking-at ada-block-label-re)
- (list (- (save-excursion (back-to-indentation) (point))
ada-label-indent) 'ada-indent))
-
- ;; nothing follows the block-start
- (t
- (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
-
-(defun ada-get-indent-subprog (orgpoint)
- "Calculate the indentation when point is just before a subprogram.
-ORGPOINT is the limit position used in the calculation."
- (let ((match-cons nil)
- (cur-indent (save-excursion (back-to-indentation) (point)))
- (foundis nil))
- ;;
- ;; is there an 'is' in front of point ?
- ;;
- (if (save-excursion
- (setq match-cons
- (ada-search-ignore-string-comment
- "\\<\\(is\\|do\\)\\>" nil orgpoint)))
- ;;
- ;; yes, then skip to its end
- ;;
- (progn
- (setq foundis t)
- (goto-char (cdr match-cons)))
- ;;
- ;; no, then goto next non-ws, if there is one in front of point
- ;;
- (progn
- (unless (ada-goto-next-non-ws orgpoint)
- (goto-char orgpoint))))
-
- (cond
- ;;
- ;; nothing follows 'is'
- ;;
- ((and
- foundis
- (save-excursion
- (not (ada-search-ignore-string-comment
- "[^ \t\n]" nil orgpoint t))))
- (list cur-indent 'ada-indent))
- ;;
- ;; is abstract/separate/new ...
- ;;
- ((and
- foundis
- (save-excursion
- (setq match-cons
- (ada-search-ignore-string-comment
- "\\<\\(separate\\|new\\|abstract\\)\\>"
- nil orgpoint))))
- (goto-char (car match-cons))
- (ada-search-ignore-string-comment ada-subprog-start-re t)
- (ada-get-indent-noindent orgpoint))
- ;;
- ;; something follows 'is'
- ;;
- ((and
- foundis
- (save-excursion (setq match-cons (ada-goto-next-non-ws orgpoint)))
- (goto-char match-cons)
- (ada-indent-on-previous-lines t orgpoint)))
- ;;
- ;; no 'is' but ';'
- ;;
- ((save-excursion
- (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward))
- (list cur-indent 0))
- ;;
- ;; no 'is' or ';'
- ;;
- (t
- (list cur-indent 'ada-broken-indent)))))
-
-(defun ada-get-indent-noindent (orgpoint)
- "Calculate the indentation when point is just before a `noindent stmt'.
-ORGPOINT is the limit position used in the calculation."
- (let ((label 0))
- (save-excursion
- (beginning-of-line)
-
- (cond
-
- ;; This one is called when indenting a line preceded by a multi-line
- ;; subprogram declaration (in that case, we are at this point inside
- ;; the parameter declaration list)
- ((ada-in-paramlist-p)
- (ada-previous-procedure)
- (list (save-excursion (back-to-indentation) (point)) 0))
-
- ;; This one is called when indenting the second line of a multi-line
- ;; declaration section, in a declare block or a record declaration
- ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$")
- (list (save-excursion (back-to-indentation) (point))
- 'ada-broken-decl-indent))
-
- ;; This one is called in every other case when indenting a line at the
- ;; top level
- (t
- (if (looking-at (concat "[ \t]*" ada-block-label-re))
- (setq label (- ada-label-indent))
-
- (let (p)
-
- ;; "with private" or "null record" cases
- (if (or (save-excursion
- (and (ada-search-ignore-string-comment "\\<private\\>"
nil orgpoint)
- (setq p (point))
- (save-excursion (forward-char -7);; skip back
"private"
- (ada-goto-previous-word)
- (looking-at "with"))))
- (save-excursion
- (and (ada-search-ignore-string-comment "\\<record\\>" nil
orgpoint)
- (setq p (point))
- (save-excursion (forward-char -6);; skip back
"record"
- (ada-goto-previous-word)
- (looking-at "null")))))
- (progn
- (goto-char p)
- (re-search-backward "\\<\\(type\\|subtype\\)\\>" nil t)
- (list (save-excursion (back-to-indentation) (point)) 0)))))
- (if (save-excursion
- (ada-search-ignore-string-comment ";" nil orgpoint nil
- 'search-forward))
- (list (+ (save-excursion (back-to-indentation) (point)) label) 0)
- (list (+ (save-excursion (back-to-indentation) (point)) label)
- 'ada-broken-indent)))))))
-
-(defun ada-get-indent-block-label (orgpoint)
- "Calculate the indentation when before a label or variable declaration.
-ORGPOINT is the limit position used in the calculation."
- (let ((match-cons nil)
- (cur-indent (save-excursion (back-to-indentation) (point))))
- (ada-search-ignore-string-comment ":" nil)
- (cond
- ;; loop label
- ((save-excursion
- (setq match-cons (ada-search-ignore-string-comment
- ada-loop-start-re nil orgpoint)))
- (goto-char (car match-cons))
- (ada-get-indent-loop orgpoint))
-
- ;; declare label
- ((save-excursion
- (setq match-cons (ada-search-ignore-string-comment
- "\\<declare\\|begin\\>" nil orgpoint)))
- (goto-char (car match-cons))
- (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
-
- ;; variable declaration
- ((ada-in-decl-p)
- (if (save-excursion
- (ada-search-ignore-string-comment ";" nil orgpoint))
- (list cur-indent 0)
- (list cur-indent 'ada-broken-indent)))
-
- ;; nothing follows colon
- (t
- (list cur-indent '(- ada-label-indent))))))
-
-(defun ada-get-indent-goto-label (orgpoint)
- "Calculate the indentation when at a goto label."
- (search-forward ">>")
- (ada-goto-next-non-ws)
- (if (>= (point) orgpoint)
- ;; labeled statement is the one we need to indent
- (list (- (point) ada-label-indent))
- ;; else indentation is indent for labeled statement
- (ada-indent-on-previous-lines t orgpoint)))
-
-(defun ada-get-indent-loop (orgpoint)
- "Calculate the indentation when just before a loop or a for ... use.
-ORGPOINT is the limit position used in the calculation."
- (let ((match-cons nil)
- (pos (point))
-
- ;; If looking at a named block, skip the label
- (label (save-excursion
- (back-to-indentation)
- (if (looking-at ada-block-label-re)
- (- ada-label-indent)
- 0))))
-
- (cond
-
- ;;
- ;; statement complete
- ;;
- ((save-excursion
- (ada-search-ignore-string-comment ";" nil orgpoint nil
- 'search-forward))
- (list (+ (save-excursion (back-to-indentation) (point)) label) 0))
- ;;
- ;; simple loop
- ;;
- ((looking-at "loop\\>")
- (setq pos (ada-get-indent-block-start orgpoint))
- (if (equal label 0)
- pos
- (list (+ (car pos) label) (cadr pos))))
-
- ;;
- ;; 'for'- loop (or also a for ... use statement)
- ;;
- ((looking-at "for\\>")
- (cond
- ;;
- ;; for ... use
- ;;
- ((save-excursion
- (and
- (goto-char (match-end 0))
- (ada-goto-next-non-ws orgpoint)
- (forward-word-strictly 1)
- (if (= (char-after) ?') (forward-word-strictly 1) t)
- (ada-goto-next-non-ws orgpoint)
- (looking-at "\\<use\\>")
- ;;
- ;; check if there is a 'record' before point
- ;;
- (progn
- (setq match-cons (ada-search-ignore-string-comment
- "record" nil orgpoint nil 'word-search-forward))
- t)))
- (if match-cons
- (progn
- (goto-char (car match-cons))
- (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
- (list (save-excursion (back-to-indentation) (point))
'ada-broken-indent))
- )
-
- ;;
- ;; for..loop
- ;;
- ((save-excursion
- (setq match-cons (ada-search-ignore-string-comment
- "loop" nil orgpoint nil 'word-search-forward)))
- (goto-char (car match-cons))
- ;;
- ;; indent according to 'loop', if it's first in the line;
- ;; otherwise to 'for'
- ;;
- (unless (save-excursion
- (back-to-indentation)
- (looking-at "\\<loop\\>"))
- (goto-char pos))
- (list (+ (save-excursion (back-to-indentation) (point)) label)
- 'ada-indent))
- ;;
- ;; for-statement is broken
- ;;
- (t
- (list (+ (save-excursion (back-to-indentation) (point)) label)
- 'ada-broken-indent))))
-
- ;;
- ;; 'while'-loop
- ;;
- ((looking-at "while\\>")
- ;;
- ;; while..loop ?
- ;;
- (if (save-excursion
- (setq match-cons (ada-search-ignore-string-comment
- "loop" nil orgpoint nil 'word-search-forward)))
-
- (progn
- (goto-char (car match-cons))
- ;;
- ;; indent according to 'loop', if it's first in the line;
- ;; otherwise to 'while'.
- ;;
- (unless (save-excursion
- (back-to-indentation)
- (looking-at "\\<loop\\>"))
- (goto-char pos))
- (list (+ (save-excursion (back-to-indentation) (point)) label)
- 'ada-indent))
-
- (list (+ (save-excursion (back-to-indentation) (point)) label)
- 'ada-broken-indent))))))
-
-(defun ada-get-indent-type (orgpoint)
- "Calculate the indentation when before a type statement.
-ORGPOINT is the limit position used in the calculation."
- (let ((match-dat nil))
- (cond
- ;;
- ;; complete record declaration
- ;;
- ((save-excursion
- (and
- (setq match-dat (ada-search-ignore-string-comment
- "end" nil orgpoint nil 'word-search-forward))
- (ada-goto-next-non-ws)
- (looking-at "\\<record\\>")
- (forward-word-strictly 1)
- (ada-goto-next-non-ws)
- (= (char-after) ?\;)))
- (goto-char (car match-dat))
- (list (save-excursion (back-to-indentation) (point)) 0))
- ;;
- ;; record type
- ;;
- ((save-excursion
- (setq match-dat (ada-search-ignore-string-comment
- "record" nil orgpoint nil 'word-search-forward)))
- (goto-char (car match-dat))
- (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
- ;;
- ;; complete type declaration
- ;;
- ((save-excursion
- (ada-search-ignore-string-comment ";" nil orgpoint nil
- 'search-forward))
- (list (save-excursion (back-to-indentation) (point)) 0))
- ;;
- ;; "type ... is", but not "type ... is ...", which is broken
- ;;
- ((save-excursion
- (and
- (ada-search-ignore-string-comment "is" nil orgpoint nil
- 'word-search-forward)
- (not (ada-goto-next-non-ws orgpoint))))
- (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
- ;;
- ;; broken statement
- ;;
- (t
- (list (save-excursion (back-to-indentation) (point))
- 'ada-broken-indent)))))
-
-
-;; -----------------------------------------------------------
-;; -- searching and matching
-;; -----------------------------------------------------------
-
-(defun ada-goto-stmt-start (&optional ignore-goto-label)
- "Move point to the beginning of the statement that point is in or after.
-Return the new position of point.
-As a special case, if we are looking at a closing parenthesis, skip to the
-open parenthesis."
- (let ((match-dat nil)
- (orgpoint (point)))
-
- (setq match-dat (ada-search-prev-end-stmt))
- (if match-dat
-
- ;;
- ;; found a previous end-statement => check if anything follows
- ;;
- (unless (looking-at "declare")
- (progn
- (unless (save-excursion
- (goto-char (cdr match-dat))
- (ada-goto-next-non-ws orgpoint ignore-goto-label))
- ;;
- ;; nothing follows => it's the end-statement directly in
- ;; front of point => search again
- ;;
- (setq match-dat (ada-search-prev-end-stmt)))
- ;;
- ;; if found the correct end-statement => goto next non-ws
- ;;
- (if match-dat
- (goto-char (cdr match-dat)))
- (ada-goto-next-non-ws)
- ))
-
- ;;
- ;; no previous end-statement => we are at the beginning of the
- ;; accessible part of the buffer
- ;;
- (progn
- (goto-char (point-min))
- ;;
- ;; skip to the very first statement, if there is one
- ;;
- (unless (ada-goto-next-non-ws orgpoint)
- (goto-char orgpoint))))
- (point)))
-
-
-(defun ada-search-prev-end-stmt ()
- "Move point to previous end statement.
-Return a cons cell whose car is the beginning and whose cdr
-is the end of the match."
- (let ((match-dat nil)
- (found nil))
-
- ;; search until found or beginning-of-buffer
- (while
- (and
- (not found)
- (setq match-dat (ada-search-ignore-string-comment
- ada-end-stmt-re t)))
-
- (goto-char (car match-dat))
- (unless (ada-in-open-paren-p)
- (cond
-
- ((and (looking-at
- "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
- (save-excursion
- (ada-goto-previous-word)
- (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
- (forward-word-strictly -1))
-
- ((looking-at "is")
- (setq found
- (and (save-excursion (ada-goto-previous-word)
- (ada-goto-previous-word)
- (not (looking-at "subtype")))
-
- (save-excursion (goto-char (cdr match-dat))
- (ada-goto-next-non-ws)
- ;; words that can go after an 'is'
- (not (looking-at
- (eval-when-compile
- (concat "\\<"
- (regexp-opt
- '("separate" "access" "array"
- "private" "abstract" "new") t)
- "\\>\\|("))))))))
-
- ((looking-at "private")
- (save-excursion
- (backward-word-strictly 1)
- (setq found (not (looking-at "is")))))
-
- (t
- (setq found t))
- )))
-
- (if found
- match-dat
- nil)))
-
-(defun ada-goto-next-non-ws (&optional limit skip-goto-label)
- "Skip to next non-whitespace character.
-Skips spaces, newlines and comments, and possibly goto labels.
-Return `point' if moved, nil if not.
-Stop the search at LIMIT.
-Do not call this function from within a string."
- (unless limit
- (setq limit (point-max)))
- (while (and (<= (point) limit)
- (or (progn (forward-comment 10000)
- (if (and (not (eobp))
- (save-excursion (forward-char 1)
- (ada-in-string-p)))
- (progn (forward-sexp 1) t)))
- (and skip-goto-label
- (looking-at ada-goto-label-re)
- (progn
- (goto-char (match-end 0))
- t)))))
- (if (< (point) limit)
- (point)
- nil)
- )
-
-
-(defun ada-goto-stmt-end (&optional limit)
- "Move point to the end of the statement that point is in or before.
-Return the new position of point or nil if not found.
-Stop the search at LIMIT."
- (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
- (point)
- nil))
-
-
-(defun ada-goto-next-word (&optional backward)
- "Move point to the beginning of the next word of Ada code.
-If BACKWARD is non-nil, jump to the beginning of the previous word.
-Return the new position of point or nil if not found."
- (let ((match-cons nil)
- (orgpoint (point)))
- (unless backward
- (skip-syntax-forward "w_"))
- (if (setq match-cons
- (ada-search-ignore-string-comment "\\sw\\|\\s_" backward nil t))
- ;;
- ;; move to the beginning of the word found
- ;;
- (progn
- (goto-char (car match-cons))
- (skip-syntax-backward "w_")
- (point))
- ;;
- ;; if not found, restore old position of point
- ;;
- (goto-char orgpoint)
- 'nil)))
-
-
-(defun ada-check-matching-start (keyword)
- "Signal an error if matching block start is not KEYWORD.
-Moves point to the matching block start."
- (ada-goto-matching-start 0)
- (unless (looking-at (concat "\\<" keyword "\\>"))
- (error "Matching start is not `%s'" keyword)))
-
-
-(defun ada-check-defun-name (defun-name)
- "Check if the name of the matching defun really is DEFUN-NAME.
-Assumes point to be already positioned by `ada-goto-matching-start'.
-Moves point to the beginning of the declaration."
-
- ;; named block without a `declare'; ada-goto-matching-start leaves
- ;; point at start of 'begin' for a block.
- (if (save-excursion
- (ada-goto-previous-word)
- (looking-at (concat "\\<" defun-name "\\> *:")))
- t ; name matches
- ;; else
- ;;
- ;; 'accept' or 'package' ?
- ;;
- (unless (looking-at ada-subprog-start-re)
- (ada-goto-decl-start))
- ;;
- ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
- ;;
- (save-excursion
- ;;
- ;; a named 'declare'-block ? => jump to the label
- ;;
- (if (looking-at "\\<declare\\>")
- (progn
- (forward-comment -1)
- (backward-word-strictly 1))
- ;;
- ;; no, => 'procedure'/'function'/'task'/'protected'
- ;;
- (progn
- (forward-word-strictly 2)
- (backward-word-strictly 1)
- ;;
- ;; skip 'body' 'type'
- ;;
- (if (looking-at "\\<\\(body\\|type\\)\\>")
- (forward-word-strictly 1))
- (forward-sexp 1)
- (backward-sexp 1)))
- ;;
- ;; should be looking-at the correct name
- ;;
- (unless (looking-at (concat "\\<" defun-name "\\>"))
- (error "Matching defun has different name: %s"
- (buffer-substring (point)
- (progn (forward-sexp 1) (point))))))))
-
-(defun ada-goto-decl-start (&optional noerror)
- "Move point to the declaration start of the current construct.
-If NOERROR is non-nil, return nil if no match was found;
-otherwise throw error."
- (let ((nest-count 1)
- (regexp (eval-when-compile
- (concat "\\<"
- (regexp-opt
- '("is" "separate" "end" "declare" "if" "new"
"begin" "generic" "when") t)
- "\\>")))
-
- ;; first should be set to t if we should stop at the first
- ;; "begin" we encounter.
- (first t)
- (count-generic nil)
- (stop-at-when nil)
- )
-
- ;; Ignore "when" most of the time, except if we are looking at the
- ;; beginning of a block (structure: case .. is
- ;; when ... =>
- ;; begin ...
- ;; exception ... )
- (if (looking-at "begin")
- (setq stop-at-when t))
-
- (if (or
- (looking-at "\\<\\(package\\|procedure\\|function\\)\\>")
- (save-excursion
- (ada-search-ignore-string-comment
- "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t)
- (looking-at "generic")))
- (setq count-generic t))
-
- ;; search backward for interesting keywords
- (while (and
- (not (zerop nest-count))
- (ada-search-ignore-string-comment regexp t))
- ;;
- ;; calculate nest-depth
- ;;
- (cond
- ;;
- ((looking-at "end")
- (ada-goto-matching-start 1 noerror)
-
- ;; In some case, two begin..end block can follow each other closely,
- ;; which we have to detect, as in
- ;; procedure P is
- ;; procedure Q is
- ;; begin
- ;; end;
- ;; begin -- here we should go to procedure, not begin
- ;; end
-
- (if (looking-at "begin")
- (let ((loop-again t))
- (save-excursion
- (while loop-again
- ;; If begin was just there as the beginning of a block
- ;; (with no declare) then do nothing, otherwise just
- ;; register that we have to find the statement that
- ;; required the begin
-
- (ada-search-ignore-string-comment
-
"\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>"
- t)
-
- (if (looking-at "end")
- (ada-goto-matching-start 1 noerror t)
-
- (setq loop-again nil)
- (unless (looking-at "begin")
- (setq nest-count (1+ nest-count))))
- ))
- )))
- ;;
- ((looking-at "generic")
- (if count-generic
- (progn
- (setq first nil)
- (setq nest-count (1- nest-count)))))
- ;;
- ((looking-at "if")
- (save-excursion
- (forward-word-strictly -1)
- (unless (looking-at "\\<end[ \t\n]*if\\>")
- (progn
- (setq nest-count (1- nest-count))
- (setq first nil)))))
-
- ;;
- ((looking-at "declare\\|generic")
- (setq nest-count (1- nest-count))
- (setq first t))
- ;;
- ((looking-at "is")
- ;; look for things to ignore
- (if
- (or
- ;; generic formal parameter
- (looking-at "is[ t]+<>")
-
- ;; A type definition, or a case statement. Note that the
- ;; goto-matching-start above on 'end record' leaves us at
- ;; 'record', not at 'type'.
- ;;
- ;; We get to a case statement here by calling
- ;; 'ada-move-to-end' from inside a case statement; then
- ;; we are not ignoring 'when'.
- (save-excursion
- ;; Skip type discriminants or case argument function call param
list
- (forward-comment -10000)
- (forward-char -1)
- (if (= (char-after) ?\))
- (progn
- (forward-char 1)
- (backward-sexp 1)
- (forward-comment -10000)
- ))
- ;; skip type or case argument name
- (skip-chars-backward "a-zA-Z0-9_.'")
- (ada-goto-previous-word)
- (and
- ;; if it's a protected type, it's the decl start we
- ;; are looking for; since we didn't see the 'end'
- ;; above, we are inside it.
- (looking-at "\\<\\(sub\\)?type\\|case\\>")
- (save-match-data
- (ada-goto-previous-word)
- (not (looking-at "\\<protected\\>"))))
- ) ; end of type definition p
-
- ;; null procedure declaration
- (save-excursion (ada-goto-next-word) (looking-at "\\<null\\>"))
- );; end or
- ;; skip this construct
- nil
- ;; this is the right "is"
- (setq nest-count (1- nest-count))
- (setq first nil)))
-
- ;;
- ((looking-at "new")
- (if (save-excursion
- (ada-goto-previous-word)
- (looking-at "is"))
- (goto-char (match-beginning 0))))
- ;;
- ((and first
- (looking-at "begin"))
- (setq nest-count 0))
- ;;
- ((looking-at "when")
- (save-excursion
- (forward-word-strictly -1)
- (unless (looking-at "\\<exit[ \t\n]*when\\>")
- (progn
- (if stop-at-when
- (setq nest-count (1- nest-count)))
- ))))
- ;;
- ((looking-at "begin")
- (setq first nil))
- ;;
- (t
- (setq nest-count (1+ nest-count))
- (setq first nil)))
-
- );; end of loop
-
- ;; check if declaration-start is really found
- (if (and
- (zerop nest-count)
- (if (looking-at "is")
- (ada-search-ignore-string-comment ada-subprog-start-re t)
- (looking-at "declare\\|generic")))
- t
- (if noerror nil
- (error "No matching proc/func/task/declare/package/protected")))
- ))
-
-(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
- "Move point to the beginning of a block-start.
-Which block depends on the value of NEST-LEVEL, which defaults to zero.
-If NOERROR is non-nil, it only returns nil if no matching start was found.
-If GOTOTHEN is non-nil, point moves to the `then' following `if'."
- (let ((nest-count (if nest-level nest-level 0))
- (found nil)
-
- (last-was-begin '())
- ;; List all keywords encountered while traversing
- ;; something like '("end" "end" "begin")
- ;; This is removed from the list when "package", "procedure",...
- ;; are seen. The goal is to find whether a package has an elaboration
- ;; part
-
- (pos nil))
-
- ;; search backward for interesting keywords
- (while (and
- (not found)
- (ada-search-ignore-string-comment ada-matching-start-re t))
-
- (unless (and (looking-at "\\<record\\>")
- (save-excursion
- (forward-word-strictly -1)
- (looking-at "\\<null\\>")))
- (progn
- ;; calculate nest-depth
- (cond
- ;; found block end => increase nest depth
- ((looking-at "end")
- (push nil last-was-begin)
- (setq nest-count (1+ nest-count)))
-
- ;; found loop/select/record/case/if => check if it starts or
- ;; ends a block
- ((looking-at "loop\\|select\\|record\\|case\\|if")
- (setq pos (point))
- (save-excursion
- ;; check if keyword follows 'end'
- (ada-goto-previous-word)
- (if (looking-at "\\<end\\>[ \t]*[^;]")
- (progn
- ;; it ends a block => increase nest depth
- (setq nest-count (1+ nest-count)
- pos (point))
- (push nil last-was-begin))
-
- ;; it starts a block => decrease nest depth
- (setq nest-count (1- nest-count))
-
- ;; Some nested "begin .. end" blocks with no "declare"?
- ;; => remove those entries
- (while (car last-was-begin)
- (setq last-was-begin (cdr (cdr last-was-begin))))
-
- (setq last-was-begin (cdr last-was-begin))
- ))
- (goto-char pos)
- )
-
- ;; found package start => check if it really is a block
- ((looking-at "package")
- (save-excursion
- ;; ignore if this is just a renames statement
- (let ((current (point))
- (pos (ada-search-ignore-string-comment
- "\\<\\(is\\|renames\\|;\\)\\>" nil)))
- (if pos
- (goto-char (car pos))
- (error (concat
- "No matching `is' or `renames' for `package' at"
- " line "
- (number-to-string (count-lines 1 (1+ current)))))))
- (unless (looking-at "renames")
- (progn
- (forward-word-strictly 1)
- (ada-goto-next-non-ws)
- ;; ignore it if it is only a declaration with 'new'
- ;; We could have package Foo is new ....
- ;; or package Foo is separate;
- ;; or package Foo is begin null; end Foo
- ;; for elaboration code (elaboration)
- (if (and (not (looking-at
"\\<\\(new\\|separate\\|begin\\)\\>"))
- (not (car last-was-begin)))
- (setq nest-count (1- nest-count))))))
-
- (setq last-was-begin (cdr last-was-begin))
- )
- ;; found task start => check if it has a body
- ((looking-at "task")
- (save-excursion
- (forward-word-strictly 1)
- (ada-goto-next-non-ws)
- (cond
- ((looking-at "\\<body\\>"))
- ((looking-at "\\<type\\>")
- ;; In that case, do nothing if there is a "is"
- (forward-word-strictly 2);; skip "type"
- (ada-goto-next-non-ws);; skip type name
-
- ;; Do nothing if we are simply looking at a simple
- ;; "task type name;" statement with no block
- (unless (looking-at ";")
- (progn
- ;; Skip the parameters
- (if (looking-at "(")
- (ada-search-ignore-string-comment ")" nil))
- (let ((tmp (ada-search-ignore-string-comment
- "\\<\\(is\\|;\\)\\>" nil)))
- (if tmp
- (progn
- (goto-char (car tmp))
- (if (looking-at "is")
- (setq nest-count (1- nest-count)))))))))
- (t
- ;; Check if that task declaration had a block attached to
- ;; it (i.e do nothing if we have just "task name;")
- (unless (progn (forward-word-strictly 1)
- (looking-at "[ \t]*;"))
- (setq nest-count (1- nest-count))))))
- (setq last-was-begin (cdr last-was-begin))
- )
-
- ((looking-at "declare")
- ;; remove entry for begin and end (include nested begin..end
- ;; groups)
- (setq last-was-begin (cdr last-was-begin))
- (let ((count 1))
- (while (and (> count 0))
- (if (equal (car last-was-begin) t)
- (setq count (1+ count))
- (setq count (1- count)))
- (setq last-was-begin (cdr last-was-begin))
- )))
-
- ((looking-at "protected")
- ;; Ignore if this is just a declaration
- (save-excursion
- (let ((pos (ada-search-ignore-string-comment
- "\\(\\<is\\>\\|\\<renames\\>\\|;\\)" nil)))
- (if pos
- (goto-char (car pos)))
- (if (looking-at "is")
- ;; remove entry for end
- (setq last-was-begin (cdr last-was-begin)))))
- (setq nest-count (1- nest-count)))
-
- ((or (looking-at "procedure")
- (looking-at "function"))
- ;; Ignore if this is just a declaration
- (save-excursion
- (let ((pos (ada-search-ignore-string-comment
- "\\(\\<is\\>\\|\\<renames\\>\\|)[ \t]*;\\)" nil)))
- (if pos
- (goto-char (car pos)))
- (if (looking-at "is")
- ;; remove entry for begin and end
- (setq last-was-begin (cdr (cdr last-was-begin))))))
- )
-
- ;; all the other block starts
- (t
- (push (looking-at "begin") last-was-begin)
- (setq nest-count (1- nest-count)))
-
- )
-
- ;; match is found, if nest-depth is zero
- (setq found (zerop nest-count))))) ; end of loop
-
- (if (bobp)
- (point)
- (if found
- ;;
- ;; match found => is there anything else to do ?
- ;;
- (progn
- (cond
- ;;
- ;; found 'if' => skip to 'then', if it's on a separate line
- ;; and GOTOTHEN is non-nil
- ;;
- ((and
- gotothen
- (looking-at "if")
- (save-excursion
- (ada-search-ignore-string-comment "then" nil nil nil
- 'word-search-forward)
- (back-to-indentation)
- (looking-at "\\<then\\>")))
- (goto-char (match-beginning 0)))
-
- ;;
- ;; found 'do' => skip back to 'accept' or 'return'
- ;;
- ((looking-at "do")
- (unless (ada-search-ignore-string-comment
- "\\<accept\\|return\\>" t)
- (error "Missing `accept' or `return' in front of `do'"))))
- (point))
-
- (if noerror
- nil
- (error "No matching start"))))))
-
-
-(defun ada-goto-matching-end (&optional nest-level noerror)
- "Move point to the end of a block.
-Which block depends on the value of NEST-LEVEL, which defaults to zero.
-If NOERROR is non-nil, it only returns nil if no matching start found."
- (let ((nest-count (or nest-level 0))
- (regex (eval-when-compile
- (concat "\\<"
- (regexp-opt '("end" "loop" "select" "begin" "case"
- "if" "task" "package" "record" "do"
- "procedure" "function") t)
- "\\>")))
- found
- pos
-
- ;; First is used for subprograms: they are generally handled
- ;; recursively, but of course we do not want to do that the
- ;; first time (see comment below about subprograms)
- (first (not (looking-at "declare"))))
-
- ;; If we are already looking at one of the keywords, this shouldn't count
- ;; in the nesting loop below, so we just make sure we don't count it.
- ;; "declare" is a special case because we need to look after the "begin"
- ;; keyword
- (if (looking-at "\\<if\\|loop\\|case\\|begin\\>")
- (forward-char 1))
-
- ;;
- ;; search forward for interesting keywords
- ;;
- (while (and
- (not found)
- (ada-search-ignore-string-comment regex nil))
-
- ;;
- ;; calculate nest-depth
- ;;
- (backward-word-strictly 1)
- (cond
- ;; procedures and functions need to be processed recursively, in
- ;; case they are defined in a declare/begin block, as in:
- ;; declare -- NL 0 (nested level)
- ;; A : Boolean;
- ;; procedure B (C : D) is
- ;; begin -- NL 1
- ;; null;
- ;; end B; -- NL 0, and we would exit
- ;; begin
- ;; end; -- we should exit here
- ;; processing them recursively avoids the need for any special
- ;; handling.
- ;; Nothing should be done if we have only the specs or a
- ;; generic instantiation.
-
- ((and (looking-at "\\<procedure\\|function\\>"))
- (if first
- (forward-word-strictly 1)
-
- (setq pos (point))
- (ada-search-ignore-string-comment "is\\|;")
- (if (= (char-before) ?s)
- (progn
- (ada-goto-next-non-ws)
- (unless (looking-at "\\<new\\>")
- (progn
- (goto-char pos)
- (ada-goto-matching-end 0 t)))))))
-
- ;; found block end => decrease nest depth
- ((looking-at "\\<end\\>")
- (setq nest-count (1- nest-count)
- found (<= nest-count 0))
- ;; skip the following keyword
- (if (progn
- (skip-chars-forward "end")
- (ada-goto-next-non-ws)
- (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
- (forward-word-strictly 1)))
-
- ;; found package start => check if it really starts a block, and is not
- ;; in fact a generic instantiation for instance
- ((looking-at "\\<package\\>")
- (ada-search-ignore-string-comment "is" nil nil nil
- 'word-search-forward)
- (ada-goto-next-non-ws)
- ;; ignore and skip it if it is only a 'new' package
- (if (looking-at "\\<new\\>")
- (goto-char (match-end 0))
- (setq nest-count (1+ nest-count)
- found (<= nest-count 0))))
-
- ;; all the other block starts
- (t
- (if (not first)
- (setq nest-count (1+ nest-count)))
- (setq found (<= nest-count 0))
- (forward-word-strictly 1))) ; end of 'cond'
-
- (setq first nil))
-
- (if found
- t
- (if noerror
- nil
- (error "No matching end")))
- ))
-
-
-(defun ada-search-ignore-string-comment
- (search-re &optional backward limit paramlists search-func)
- "Regexp-search for SEARCH-RE, ignoring comments, strings.
-Returns a cons cell of begin and end of match data or nil, if not found.
-If BACKWARD is non-nil, search backward; search forward otherwise.
-The search stops at pos LIMIT.
-If PARAMLISTS is nil, ignore parameter lists.
-The search is done using SEARCH-FUNC. SEARCH-FUNC can be optimized
-in case we are searching for a constant string.
-Point is moved at the beginning of the SEARCH-RE."
- (let (found
- begin
- end
- parse-result)
-
- ;; FIXME: need to pass BACKWARD to search-func!
- (unless search-func
- (setq search-func (if backward 're-search-backward 're-search-forward)))
-
- ;;
- ;; search until found or end-of-buffer
- ;; We have to test that we do not look further than limit
- ;;
- (with-syntax-table ada-mode-symbol-syntax-table
- (while (and (not found)
- (or (not limit)
- (or (and backward (<= limit (point)))
- (>= limit (point))))
- (funcall search-func search-re limit 1))
- (setq begin (match-beginning 0))
- (setq end (match-end 0))
- (setq parse-result (parse-partial-sexp (point-at-bol) (point)))
- (cond
- ;;
- ;; If inside a string, skip it (and the following comments)
- ;;
- ((ada-in-string-p parse-result)
- (if (featurep 'xemacs)
- (search-backward "\"" nil t)
- (goto-char (nth 8 parse-result)))
- (unless backward (forward-sexp 1)))
- ;;
- ;; If inside a comment, skip it (and the following comments)
- ;; There is a special code for comments at the end of the file
- ;;
- ((ada-in-comment-p parse-result)
- (if (featurep 'xemacs)
- (progn
- (forward-line 1)
- (beginning-of-line)
- (forward-comment -1))
- (goto-char (nth 8 parse-result)))
- (unless backward
- ;; at the end of the file, it is not possible to skip a comment
- ;; so we just go at the end of the line
- (if (forward-comment 1)
- (progn
- (forward-comment 1000)
- (beginning-of-line))
- (end-of-line))))
- ;;
- ;; directly in front of a comment => skip it, if searching forward
- ;;
- ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
- (unless backward (progn (forward-char -1) (forward-comment 1000))))
-
- ;;
- ;; found a parameter-list but should ignore it => skip it
- ;;
- ((and (not paramlists) (ada-in-paramlist-p))
- (if backward
- (search-backward "(" nil t)
- (search-forward ")" nil t)))
- ;;
- ;; found what we were looking for
- ;;
- (t
- (setq found t))))) ; end of loop
-
- (if found
- (cons begin end)
- nil)))
-
-;; -------------------------------------------------------
-;; -- Testing the position of the cursor
-;; -------------------------------------------------------
-
-(defun ada-in-decl-p ()
- "Return t if point is inside a declarative part.
-Assumes point to be at the end of a statement."
- (or (ada-in-paramlist-p)
- (save-excursion
- (ada-goto-decl-start t))))
-
-
-(defun ada-looking-at-semi-or ()
- "Return t if looking at an `or' following a semicolon."
- (save-excursion
- (and (looking-at "\\<or\\>")
- (progn
- (forward-word-strictly 1)
- (ada-goto-stmt-start)
- (looking-at "\\<or\\>")))))
-
-
-(defun ada-looking-at-semi-private ()
- "Return t if looking at the start of a private section in a package.
-Return nil if the private is part of the package name, as in
-'private package A is...' (this can only happen at top level)."
- (save-excursion
- (and (looking-at "\\<private\\>")
- (not (looking-at "\\<private[ \t]*\\(package\\|generic\\)"))
-
- ;; Make sure this is the start of a private section (ie after
- ;; a semicolon or just after the package declaration, but not
- ;; after a 'type ... is private' or 'is new ... with private'
- ;;
- ;; Note that a 'private' statement at the beginning of the buffer
- ;; does not indicate a private section, since this is instead a
- ;; 'private procedure ...'
- (progn (forward-comment -1000)
- (and (not (bobp))
- (or (= (char-before) ?\;)
- (and (forward-word-strictly -3)
- (looking-at "\\<package\\>"))))))))
-
-
-(defun ada-in-paramlist-p ()
- "Return t if point is inside the parameter-list of a declaration, but not a
subprogram call or aggregate."
- (save-excursion
- (and
- (ada-search-ignore-string-comment "(\\|)" t nil t)
- ;; inside parentheses ?
- (= (char-after) ?\()
-
- ;; We could be looking at two things here:
- ;; operator definition: function "." (
- ;; subprogram definition: procedure .... (
- ;; Let's skip back over the first one
- (progn
- (skip-chars-backward " \t\n")
- (if (= (char-before) ?\")
- (backward-char 3)
- (backward-word-strictly 1))
- t)
-
- ;; and now over the second one
- (backward-word-strictly 1)
-
- ;; We should ignore the case when the reserved keyword is in a
- ;; comment (for instance, when we have:
- ;; -- .... package
- ;; Test (A)
- ;; we should return nil
-
- (not (ada-in-string-or-comment-p))
-
- ;; right keyword two words before parenthesis ?
- ;; Type is in this list because of discriminants
- ;; pragma is not, because the syntax is that of a subprogram call.
- (looking-at (eval-when-compile
- (concat "\\<\\("
- "procedure\\|function\\|body\\|"
- "task\\|entry\\|accept\\|"
- "access[ \t]+procedure\\|"
- "access[ \t]+function\\|"
- "type\\)\\>"))))))
-
-(defun ada-search-ignore-complex-boolean (regexp backwardp)
- "Search for REGEXP, ignoring comments, strings, `and then', `or else'.
-If BACKWARDP is non-nil, search backward; search forward otherwise."
- (let (result)
- (while (and (setq result (ada-search-ignore-string-comment regexp backwardp))
- (save-excursion (forward-word-strictly -1)
- (looking-at "and then\\|or else"))))
- result))
-
-(defun ada-in-open-paren-p ()
- "Non-nil if in an open parenthesis.
-Return value is the position of the first non-ws behind the last unclosed
-parenthesis, or nil."
- (save-excursion
- (let ((parse (parse-partial-sexp
- (point)
- (or (car (ada-search-ignore-complex-boolean
- "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>"
- t))
- (point-min)))))
-
- (if (nth 1 parse)
- (progn
- (goto-char (1+ (nth 1 parse)))
-
- ;; Skip blanks, if they are not followed by a comment
- ;; See:
- ;; type A is ( Value_0,
- ;; Value_1);
- ;; type B is ( -- comment
- ;; Value_2);
-
- (if (or (not ada-indent-handle-comment-special)
- (not (looking-at "[ \t]+--")))
- (skip-chars-forward " \t"))
-
- (point))))))
-
-
-;; -----------------------------------------------------------
-;; -- Behavior Of TAB Key
-;; -----------------------------------------------------------
-
-(defun ada-tab ()
- "Do indenting or tabbing according to `ada-tab-policy'.
-In Transient Mark mode, if the mark is active, operate on the contents
-of the region. Otherwise, operate only on the current line."
- (interactive)
- (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
- ((eq ada-tab-policy 'indent-auto)
- (if (ada-region-selected)
- (ada-indent-region (region-beginning) (region-end))
- (ada-indent-current)))
- ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
- ))
-
-(defun ada-untab (_arg)
- "Delete leading indenting according to `ada-tab-policy'."
- ;; FIXME: ARG is ignored
- (interactive "P")
- (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
- ((eq ada-tab-policy 'indent-auto) (error "Not implemented"))
- ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
- ))
-
-(defun ada-indent-current-function ()
- "Ada mode version of the `indent-line-function'."
- (interactive "*")
- (let ((starting-point (point-marker)))
- (beginning-of-line)
- (ada-tab)
- (if (< (point) starting-point)
- (goto-char starting-point))
- (set-marker starting-point nil)
- ))
-
-(defun ada-tab-hard ()
- "Indent current line to next tab stop."
- (interactive)
- (save-excursion
- (beginning-of-line)
- (insert-char ? ada-indent))
- (if (bolp) (forward-char ada-indent)))
-
-(defun ada-untab-hard ()
- "Indent current line to previous tab stop."
- (interactive)
- (indent-rigidly (point-at-bol) (point-at-eol) (- 0 ada-indent)))
-
-
-;; ------------------------------------------------------------
-;; -- Miscellaneous
-;; ------------------------------------------------------------
-
-;; Not needed any more for Emacs 21.2, but still needed for backward
-;; compatibility
-(defun ada-remove-trailing-spaces ()
- "Remove trailing spaces in the whole buffer."
- (interactive)
- (save-match-data
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+$" (point-max) t)
- (replace-match "" nil nil))))))
-
-(defun ada-gnat-style ()
- "Clean up comments, `(' and `,' for GNAT style checking switch."
- (interactive)
- (save-excursion
-
- ;; The \n is required, or the line after an empty comment line is
- ;; simply ignored.
- (goto-char (point-min))
- (while (re-search-forward "--[ \t]*\\([^-\n]\\)" nil t)
- (replace-match "-- \\1")
- (forward-line 1)
- (beginning-of-line))
-
- (goto-char (point-min))
- (while (re-search-forward "\\>(" nil t)
- (if (not (ada-in-string-or-comment-p))
- (replace-match " (")))
- (goto-char (point-min))
- (while (re-search-forward ";--" nil t)
- (forward-char -1)
- (if (not (ada-in-string-or-comment-p))
- (replace-match "; --")))
- (goto-char (point-min))
- (while (re-search-forward "([ \t]+" nil t)
- (if (not (ada-in-string-or-comment-p))
- (replace-match "(")))
- (goto-char (point-min))
- (while (re-search-forward ")[ \t]+)" nil t)
- (if (not (ada-in-string-or-comment-p))
- (replace-match "))")))
- (goto-char (point-min))
- (while (re-search-forward "\\>:" nil t)
- (if (not (ada-in-string-or-comment-p))
- (replace-match " :")))
-
- ;; Make sure there is a space after a ','.
- ;; Always go back to the beginning of the match, since otherwise
- ;; a statement like ('F','D','E') is incorrectly modified.
- (goto-char (point-min))
- (while (re-search-forward ",[ \t]*\\(.\\)" nil t)
- (if (not (save-excursion
- (goto-char (match-beginning 0))
- (ada-in-string-or-comment-p)))
- (replace-match ", \\1")))
-
- ;; Operators should be surrounded by spaces.
- (goto-char (point-min))
- (while (re-search-forward
- "[ \t]*\\(/=\\|\\*\\*\\|:=\\|\\.\\.\\|[-:+*/]\\)[ \t]*"
- nil t)
- (goto-char (match-beginning 1))
- (if (or (looking-at "--")
- (ada-in-string-or-comment-p))
- (progn
- (forward-line 1)
- (beginning-of-line))
- (cond
- ((string= (match-string 1) "/=")
- (replace-match " /= "))
- ((string= (match-string 1) "..")
- (replace-match " .. "))
- ((string= (match-string 1) "**")
- (replace-match " ** "))
- ((string= (match-string 1) ":=")
- (replace-match " := "))
- (t
- (replace-match " \\1 ")))
- (forward-char 1)))
- ))
-
-
-
-;; -------------------------------------------------------------
-;; -- Moving To Procedures/Packages/Statements
-;; -------------------------------------------------------------
-
-(defun ada-move-to-start ()
- "Move point to the matching start of the current Ada structure."
- (interactive)
- (let ((pos (point)))
- (with-syntax-table ada-mode-symbol-syntax-table
-
- (save-excursion
- ;;
- ;; do nothing if in string or comment or not on 'end ...;'
- ;; or if an error occurs during processing
- ;;
- (or
- (ada-in-string-or-comment-p)
- (and (progn
- (or (looking-at "[ \t]*\\<end\\>")
- (backward-word-strictly 1))
- (or (looking-at "[ \t]*\\<end\\>")
- (backward-word-strictly 1))
- (or (looking-at "[ \t]*\\<end\\>")
- (error "Not on end ...;")))
- (ada-goto-matching-start 1)
- (setq pos (point))
-
- ;;
- ;; on 'begin' => go on, according to user option
- ;;
- ada-move-to-declaration
- (looking-at "\\<begin\\>")
- (ada-goto-decl-start)
- (setq pos (point))))
-
- ) ; end of save-excursion
-
- ;; now really move to the found position
- (goto-char pos))))
-
-(defun ada-move-to-end ()
- "Move point to the end of the block around point.
-Moves to `begin' if in a declarative part."
- (interactive)
- (let ((pos (point))
- decl-start)
- (with-syntax-table ada-mode-symbol-syntax-table
-
- (save-excursion
-
- (cond
- ;; Go to the beginning of the current word, and check if we are
- ;; directly on 'begin'
- ((save-excursion
- (skip-syntax-backward "w")
- (looking-at "\\<begin\\>"))
- (ada-goto-matching-end 1))
-
- ;; on first line of subprogram body
- ;; Do nothing for specs or generic instantiation, since these are
- ;; handled as the general case (find the enclosing block)
- ;; We also need to make sure that we ignore nested subprograms
- ((save-excursion
- (and (skip-syntax-backward "w")
- (looking-at "\\<function\\>\\|\\<procedure\\>" )
- (ada-search-ignore-string-comment "is\\|;")
- (not (= (char-before) ?\;))
- ))
- (skip-syntax-backward "w")
- (ada-goto-matching-end 0 t))
-
- ;; on first line of task declaration
- ((save-excursion
- (and (ada-goto-stmt-start)
- (looking-at "\\<task\\>" )
- (forward-word-strictly 1)
- (ada-goto-next-non-ws)
- (looking-at "\\<body\\>")))
- (ada-search-ignore-string-comment "begin" nil nil nil
- 'word-search-forward))
- ;; accept block start
- ((save-excursion
- (and (ada-goto-stmt-start)
- (looking-at "\\<accept\\>" )))
- (ada-goto-matching-end 0))
- ;; package start
- ((save-excursion
- (setq decl-start (and (ada-goto-decl-start t) (point)))
- (and decl-start (looking-at "\\<package\\>")))
- (ada-goto-matching-end 1))
-
- ;; On a "declare" keyword
- ((save-excursion
- (skip-syntax-backward "w")
- (looking-at "\\<declare\\>"))
- (ada-goto-matching-end 0 t))
-
- ;; inside a 'begin' ... 'end' block
- (decl-start
- (goto-char decl-start)
- (ada-goto-matching-end 0 t))
-
- ;; (hopefully ;-) everything else
- (t
- (ada-goto-matching-end 1)))
- (setq pos (point))
- )
-
- ;; now really move to the position found
- (goto-char pos))))
-
-(defun ada-next-procedure ()
- "Move point to next procedure."
- (interactive)
- (end-of-line)
- (if (re-search-forward ada-procedure-start-regexp nil t)
- (goto-char (match-beginning 4))
- (error "No more functions/procedures/tasks")))
-
-(defun ada-previous-procedure ()
- "Move point to previous procedure."
- (interactive)
- (beginning-of-line)
- (if (re-search-backward ada-procedure-start-regexp nil t)
- (goto-char (match-beginning 4))
- (error "No more functions/procedures/tasks")))
-
-(defun ada-next-package ()
- "Move point to next package."
- (interactive)
- (end-of-line)
- (if (re-search-forward ada-package-start-regexp nil t)
- (goto-char (match-beginning 1))
- (error "No more packages")))
-
-(defun ada-previous-package ()
- "Move point to previous package."
- (interactive)
- (beginning-of-line)
- (if (re-search-backward ada-package-start-regexp nil t)
- (goto-char (match-beginning 1))
- (error "No more packages")))
-
-
-;; ------------------------------------------------------------
-;; -- Define keymap and menus for Ada
-;; -------------------------------------------------------------
-
-(defun ada-create-keymap ()
- "Create the keymap associated with the Ada mode."
-
- ;; All non-standard keys go into ada-mode-extra-map
- (define-key ada-mode-map ada-mode-extra-prefix ada-mode-extra-map)
-
- ;; Indentation and Formatting
- (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional)
- (define-key ada-mode-map "\C-m" 'ada-indent-newline-indent-conditional)
- (define-key ada-mode-map "\t" 'ada-tab)
- (define-key ada-mode-map "\C-c\t" 'ada-justified-indent-current)
- (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
- (define-key ada-mode-map [(shift tab)] 'ada-untab)
- (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
- ;; We don't want to make meta-characters case-specific.
-
- ;; Movement
- (define-key ada-mode-map "\M-\C-e" 'ada-next-procedure)
- (define-key ada-mode-map "\M-\C-a" 'ada-previous-procedure)
- (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
- (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
-
- ;; Compilation
- (unless (lookup-key ada-mode-map "\C-c\C-c")
- (define-key ada-mode-map "\C-c\C-c" 'compile))
-
- ;; Casing
- (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
- (define-key ada-mode-map "\C-c\C-t" 'ada-case-read-exceptions)
- (define-key ada-mode-map "\C-c\C-y" 'ada-create-case-exception)
- (define-key ada-mode-map "\C-c\C-\M-y" 'ada-create-case-exception-substring)
-
- ;; On XEmacs, you can easily specify whether DEL should deletes
- ;; one character forward or one character backward. Take this into
- ;; account
- (define-key ada-mode-map
- (if (boundp 'delete-key-deletes-forward) [backspace] "\177")
- 'backward-delete-char-untabify)
-
- ;; Make body
- (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body)
-
- ;; Use predefined function of Emacs19 for comments (RE)
- ;; FIXME: Made redundant with Emacs-21's standard comment-dwim binding on M-;
- (define-key ada-mode-map "\C-c;" 'comment-region)
- (define-key ada-mode-map "\C-c:" 'ada-uncomment-region)
-
- ;; The following keys are bound to functions defined in ada-xref.el or
- ;; ada-prj,el., However, RMS rightly thinks that the code should be shared,
- ;; and activated only if the right compiler is used
-
- (define-key ada-mode-map (if (featurep 'xemacs) '(shift button3) [S-mouse-3])
- 'ada-point-and-xref)
- (define-key ada-mode-map [(control tab)] 'ada-complete-identifier)
-
- (define-key ada-mode-extra-map "o" 'ff-find-other-file)
- (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
- (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration)
- (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)
- (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
- (define-key ada-mode-extra-map "c" 'ada-change-prj)
- (define-key ada-mode-extra-map "d" 'ada-set-default-project-file)
- (define-key ada-mode-extra-map "g" 'ada-gdb-application)
- (define-key ada-mode-map "\C-c\C-m" 'ada-set-main-compile-application)
- (define-key ada-mode-extra-map "r" 'ada-run-application)
- (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
- (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
- (define-key ada-mode-extra-map "l" 'ada-find-local-references)
- (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
- (define-key ada-mode-extra-map "f" 'ada-find-file)
-
- (define-key ada-mode-extra-map "u" 'ada-prj-edit)
-
- (define-key ada-mode-map "\C-xnd" 'ada-narrow-to-defun); override
narrow-to-defun
-
- ;; The templates, defined in ada-stmt.el
-
- (let ((map (make-sparse-keymap)))
- (define-key map "h" 'ada-header)
- (define-key map "\C-a" 'ada-array)
- (define-key map "b" 'ada-exception-block)
- (define-key map "d" 'ada-declare-block)
- (define-key map "c" 'ada-case)
- (define-key map "\C-e" 'ada-elsif)
- (define-key map "e" 'ada-else)
- (define-key map "\C-k" 'ada-package-spec)
- (define-key map "k" 'ada-package-body)
- (define-key map "\C-p" 'ada-procedure-spec)
- (define-key map "p" 'ada-subprogram-body)
- (define-key map "\C-f" 'ada-function-spec)
- (define-key map "f" 'ada-for-loop)
- (define-key map "i" 'ada-if)
- (define-key map "l" 'ada-loop)
- (define-key map "\C-r" 'ada-record)
- (define-key map "\C-s" 'ada-subtype)
- (define-key map "S" 'ada-tabsize)
- (define-key map "\C-t" 'ada-task-spec)
- (define-key map "t" 'ada-task-body)
- (define-key map "\C-y" 'ada-type)
- (define-key map "\C-v" 'ada-private)
- (define-key map "u" 'ada-use)
- (define-key map "\C-u" 'ada-with)
- (define-key map "\C-w" 'ada-when)
- (define-key map "w" 'ada-while-loop)
- (define-key map "\C-x" 'ada-exception)
- (define-key map "x" 'ada-exit)
- (define-key ada-mode-extra-map "t" map))
- )
-
-
-(defun ada-create-menu ()
- "Create the Ada menu as shown in the menu bar."
- (let ((m '("Ada"
- ("Help"
- ["Ada Mode" (info "ada-mode") t]
- ["GNAT User's Guide" (info "gnat_ugn")
- (eq ada-which-compiler 'gnat)]
- ["GNAT Reference Manual" (info "gnat_rm")
- (eq ada-which-compiler 'gnat)]
- ["Gcc Documentation" (info "gcc")
- (eq ada-which-compiler 'gnat)]
- ["Gdb Documentation" (info "gdb")
- (eq ada-which-compiler 'gnat)]
- ["Ada95 Reference Manual" (info "arm95") t])
- ("Options" :included (derived-mode-p 'ada-mode)
- ["Auto Casing" (setq ada-auto-case (not ada-auto-case))
- :style toggle :selected ada-auto-case]
- ["Auto Indent After Return"
- (setq ada-indent-after-return (not ada-indent-after-return))
- :style toggle :selected ada-indent-after-return]
- ["Automatically Recompile For Cross-references"
- (setq ada-xref-create-ali (not ada-xref-create-ali))
- :style toggle :selected ada-xref-create-ali
- :included (eq ada-which-compiler 'gnat)]
- ["Confirm Commands"
- (setq ada-xref-confirm-compile (not ada-xref-confirm-compile))
- :style toggle :selected ada-xref-confirm-compile
- :included (eq ada-which-compiler 'gnat)]
- ["Show Cross-references In Other Buffer"
- (setq ada-xref-other-buffer (not ada-xref-other-buffer))
- :style toggle :selected ada-xref-other-buffer
- :included (eq ada-which-compiler 'gnat)]
- ["Tight Integration With GNU Visual Debugger"
- (setq ada-tight-gvd-integration (not ada-tight-gvd-integration))
- :style toggle :selected ada-tight-gvd-integration
- :included (string-match "gvd" ada-prj-default-debugger)])
- ["Customize" (customize-group 'ada)
- :included (fboundp 'customize-group)]
- ["Check file" ada-check-current t]
- ["Compile file" ada-compile-current t]
- ["Set main and Build" ada-set-main-compile-application t]
- ["Show main" ada-show-current-main t]
- ["Build" ada-compile-application t]
- ["Run" ada-run-application t]
- ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)]
- ["------" nil nil]
- ("Project"
- ["Show project" ada-show-current-project t]
- ["Load..." ada-set-default-project-file t]
- ["New..." ada-prj-new t]
- ["Edit..." ada-prj-edit t])
- ("Goto" :included (derived-mode-p 'ada-mode)
- ["Goto Declaration/Body" ada-goto-declaration
- (eq ada-which-compiler 'gnat)]
- ["Goto Body" ada-goto-body
- (eq ada-which-compiler 'gnat)]
- ["Goto Declaration Other Frame"
- ada-goto-declaration-other-frame
- (eq ada-which-compiler 'gnat)]
- ["Goto Previous Reference" ada-xref-goto-previous-reference
- (eq ada-which-compiler 'gnat)]
- ["List Local References" ada-find-local-references
- (eq ada-which-compiler 'gnat)]
- ["List References" ada-find-references
- (eq ada-which-compiler 'gnat)]
- ["Goto Reference To Any Entity" ada-find-any-references
- (eq ada-which-compiler 'gnat)]
- ["Goto Parent Unit" ada-goto-parent
- (eq ada-which-compiler 'gnat)]
- ["--" nil nil]
- ["Next compilation error" next-error t]
- ["Previous Package" ada-previous-package t]
- ["Next Package" ada-next-package t]
- ["Previous Procedure" ada-previous-procedure t]
- ["Next Procedure" ada-next-procedure t]
- ["Goto Start Of Statement" ada-move-to-start t]
- ["Goto End Of Statement" ada-move-to-end t]
- ["-" nil nil]
- ["Other File" ff-find-other-file t]
- ["Other File Other Window" ada-ff-other-window t])
- ("Edit" :included (derived-mode-p 'ada-mode)
- ["Search File On Source Path" ada-find-file t]
- ["------" nil nil]
- ["Complete Identifier" ada-complete-identifier t]
- ["-----" nil nil]
- ["Indent Line" ada-indent-current-function t]
- ["Justify Current Indentation" ada-justified-indent-current t]
- ["Indent Lines in Selection" ada-indent-region t]
- ["Indent Lines in File"
- (ada-indent-region (point-min) (point-max)) t]
- ["Format Parameter List" ada-format-paramlist t]
- ["-" nil nil]
- ["Comment Selection" comment-region t]
- ["Uncomment Selection" ada-uncomment-region t]
- ["--" nil nil]
- ["Fill Comment Paragraph" fill-paragraph t]
- ["Fill Comment Paragraph Justify"
- ada-fill-comment-paragraph-justify t]
- ["Fill Comment Paragraph Postfix"
- ada-fill-comment-paragraph-postfix t]
- ["---" nil nil]
- ["Adjust Case Selection" ada-adjust-case-region t]
- ["Adjust Case in File" ada-adjust-case-buffer t]
- ["Create Case Exception" ada-create-case-exception t]
- ["Create Case Exception Substring"
- ada-create-case-exception-substring t]
- ["Reload Case Exceptions" ada-case-read-exceptions t]
- ["----" nil nil]
- ["Make body for subprogram" ada-make-subprogram-body t]
- ["-----" nil nil]
- ["Narrow to subprogram" ada-narrow-to-defun t])
- ("Templates"
- :included (derived-mode-p 'ada-mode)
- ["Header" ada-header t]
- ["-" nil nil]
- ["Package Body" ada-package-body t]
- ["Package Spec" ada-package-spec t]
- ["Function Spec" ada-function-spec t]
- ["Procedure Spec" ada-procedure-spec t]
- ["Proc/func Body" ada-subprogram-body t]
- ["Task Body" ada-task-body t]
- ["Task Spec" ada-task-spec t]
- ["Declare Block" ada-declare-block t]
- ["Exception Block" ada-exception-block t]
- ["--" nil nil]
- ["Entry" ada-entry t]
- ["Entry family" ada-entry-family t]
- ["Select" ada-select t]
- ["Accept" ada-accept t]
- ["Or accept" ada-or-accept t]
- ["Or delay" ada-or-delay t]
- ["Or terminate" ada-or-terminate t]
- ["---" nil nil]
- ["Type" ada-type t]
- ["Private" ada-private t]
- ["Subtype" ada-subtype t]
- ["Record" ada-record t]
- ["Array" ada-array t]
- ["----" nil nil]
- ["If" ada-if t]
- ["Else" ada-else t]
- ["Elsif" ada-elsif t]
- ["Case" ada-case t]
- ["-----" nil nil]
- ["While Loop" ada-while-loop t]
- ["For Loop" ada-for-loop t]
- ["Loop" ada-loop t]
- ["------" nil nil]
- ["Exception" ada-exception t]
- ["Exit" ada-exit t]
- ["When" ada-when t])
- )))
-
- (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode" m)
- (if (featurep 'xemacs)
- (progn
- (define-key ada-mode-map [menu-bar] ada-mode-menu)
- (setq mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
-
-
-;; -------------------------------------------------------
-;; Commenting/Uncommenting code
-;; The following two calls are provided to enhance the standard
-;; comment-region function, which only allows uncommenting if the
-;; comment is at the beginning of a line. If the line have been re-indented,
-;; we are unable to use comment-region, which makes no sense.
-;;
-;; In addition, we provide an interface to the standard comment handling
-;; function for justifying the comments.
-;; -------------------------------------------------------
-
-(when (or (<= emacs-major-version 20) (featurep 'xemacs))
- (defadvice comment-region (before ada-uncomment-anywhere disable)
- (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas
- ;; \C-u 2 sets arg to '2' (fixed by S.Leake)
- (derived-mode-p 'ada-mode))
- (save-excursion
- (let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))
- (goto-char beg)
- (while (re-search-forward cs end t)
- (replace-match comment-start))
- )))))
-
-(defun ada-uncomment-region (beg end &optional arg)
- "Uncomment region BEG .. END.
-ARG gives number of comment characters."
- (interactive "r\nP")
-
- ;; This advice is not needed anymore with Emacs21. However, for older
- ;; versions, as well as for XEmacs, we still need to enable it.
- (if (or (<= emacs-major-version 20) (featurep 'xemacs))
- (progn
- (ad-activate 'comment-region)
- (comment-region beg end (- (or arg 2)))
- (ad-deactivate 'comment-region))
- (comment-region beg end (list (- (or arg 2))))
- (ada-indent-region beg end)))
-
-(defun ada-fill-comment-paragraph-justify ()
- "Fill current comment paragraph and justify each line as well."
- (interactive)
- (ada-fill-comment-paragraph 'full))
-
-(defun ada-fill-comment-paragraph-postfix ()
- "Fill current comment paragraph and justify each line as well.
-Adds `ada-fill-comment-postfix' at the end of each line."
- (interactive)
- (ada-fill-comment-paragraph 'full t))
-
-(defun ada-fill-comment-paragraph (&optional justify postfix)
- "Fill the current comment paragraph.
-If JUSTIFY is non-nil, each line is justified as well.
-If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended
-to each line filled and justified.
-The paragraph is indented on the first line."
- (interactive "P")
-
- ;; check if inside comment or just in front a comment
- (if (and (not (ada-in-comment-p))
- (not (looking-at "[ \t]*--")))
- (error "Not inside comment"))
-
- (let* (indent from to
- (opos (point-marker))
-
- ;; Sets this variable to nil, otherwise it prevents
- ;; fill-region-as-paragraph to work on Emacs <= 20.2
- (parse-sexp-lookup-properties nil)
-
- fill-prefix
- (fill-column (current-fill-column)))
-
- ;; Find end of paragraph
- (back-to-indentation)
- (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
- (forward-line 1)
-
- ;; If we were at the last line in the buffer, create a dummy empty
- ;; line at the end of the buffer.
- (if (eobp)
- (insert "\n")
- (back-to-indentation)))
- (beginning-of-line)
- (setq to (point-marker))
- (goto-char opos)
-
- ;; Find beginning of paragraph
- (back-to-indentation)
- (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
- (forward-line -1)
- (back-to-indentation))
-
- ;; We want one line above the first one, unless we are at the beginning
- ;; of the buffer
- (unless (bobp)
- (forward-line 1))
- (beginning-of-line)
- (setq from (point-marker))
-
- ;; Calculate the indentation we will need for the paragraph
- (back-to-indentation)
- (setq indent (current-column))
- ;; unindent the first line of the paragraph
- (delete-region from (point))
-
- ;; Remove the old postfixes
- (goto-char from)
- (while (re-search-forward "--\n" to t)
- (replace-match "\n"))
-
- (goto-char (1- to))
- (setq to (point-marker))
-
- ;; Indent and justify the paragraph
- (setq fill-prefix ada-fill-comment-prefix)
- (set-left-margin from to indent)
- (if postfix
- (setq fill-column (- fill-column (length ada-fill-comment-postfix))))
-
- (fill-region-as-paragraph from to justify)
-
- ;; Add the postfixes if required
- (if postfix
- (save-restriction
- (goto-char from)
- (narrow-to-region from to)
- (while (not (eobp))
- (end-of-line)
- (insert-char ? (- fill-column (current-column)))
- (insert ada-fill-comment-postfix)
- (forward-line))
- ))
-
- ;; In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is
- ;; inserted at the end. Delete it
- (if (or (featurep 'xemacs)
- (<= emacs-major-version 19)
- (and (= emacs-major-version 20)
- (<= emacs-minor-version 2)))
- (progn
- (goto-char to)
- (end-of-line)
- (delete-char 1)))
-
- (goto-char opos)))
-
-
-;; ---------------------------------------------------
-;; support for find-file.el
-;; These functions are used by find-file to guess the file names from
-;; unit names, and to find the other file (spec or body) from the current
-;; file (body or spec).
-;; It is also used to find in which function we are, so as to put the
-;; cursor at the correct position.
-;; Standard Ada does not force any relation between unit names and file names,
-;; so some of these functions can only be a good approximation. However, they
-;; are also overridden in `ada-xref'.el when we know that the user is using
-;; GNAT.
-;; ---------------------------------------------------
-
-;; Overridden when we work with GNAT, to use gnatkrunch
-(defun ada-make-filename-from-adaname (adaname)
- "Determine the filename in which ADANAME is found.
-This matches the GNAT default naming convention, except for
-pre-defined units."
- (while (string-match "\\." adaname)
- (setq adaname (replace-match "-" t t adaname)))
- (downcase adaname)
- )
-
-(defun ada-other-file-name ()
- "Return the name of the other file.
-The name returned is the body if `current-buffer' is the spec,
-or the spec otherwise."
-
- (let ((is-spec nil)
- (is-body nil)
- (suffixes ada-spec-suffixes)
- (name (buffer-file-name)))
-
- ;; Guess whether we have a spec or a body, and get the basename of the
- ;; file. Since the extension may not start with '.', we can not use
- ;; file-name-extension
- (while (and (not is-spec)
- suffixes)
- (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
- (setq is-spec t
- name (match-string 1 name)))
- (setq suffixes (cdr suffixes)))
-
- (if (not is-spec)
- (progn
- (setq suffixes ada-body-suffixes)
- (while (and (not is-body)
- suffixes)
- (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
- (setq is-body t
- name (match-string 1 name)))
- (setq suffixes (cdr suffixes)))))
-
- ;; If this wasn't in either list, return name itself
- (if (not (or is-spec is-body))
- name
-
- ;; Else find the other possible names
- (if is-spec
- (setq suffixes ada-body-suffixes)
- (setq suffixes ada-spec-suffixes))
- (setq is-spec name)
-
- (while suffixes
-
- ;; If we are using project file, search for the other file in all
- ;; the possible src directories.
-
- (if (fboundp 'ada-find-src-file-in-dir)
- (let ((other
- (ada-find-src-file-in-dir
- (file-name-nondirectory (concat name (car suffixes))))))
- (if other
- (setq is-spec other)))
-
- ;; Else search in the current directory
- (if (file-exists-p (concat name (car suffixes)))
- (setq is-spec (concat name (car suffixes)))))
- (setq suffixes (cdr suffixes)))
-
- is-spec)))
-
-(defun ada-which-function-are-we-in ()
- "Return the name of the function whose definition/declaration point is in.
-Used in `ff-pre-load-hook'."
- (setq ff-function-name nil)
- (save-excursion
- (end-of-line);; make sure we get the complete name
- (or (if (re-search-backward ada-procedure-start-regexp nil t)
- (setq ff-function-name (match-string 5)))
- (if (re-search-backward ada-package-start-regexp nil t)
- (setq ff-function-name (match-string 4))))
- ))
-
-
-(defvar ada-last-which-function-line -1
- "Last line on which `ada-which-function' was called.")
-(defvar ada-last-which-function-subprog 0
- "Last subprogram name returned by `ada-which-function'.")
-(make-variable-buffer-local 'ada-last-which-function-subprog)
-(make-variable-buffer-local 'ada-last-which-function-line)
-
-
-(defun ada-which-function ()
- "Return the name of the function whose body the point is in.
-This function works even in the case of nested subprograms, whereas the
-standard Emacs function `which-function' does not.
-Since the search can be long, the results are cached."
-
- (let ((line (count-lines 1 (point)))
- (pos (point))
- end-pos
- func-name indent
- found)
-
- ;; If this is the same line as before, simply return the same result
- (if (= line ada-last-which-function-line)
- ada-last-which-function-subprog
-
- (save-excursion
- ;; In case the current line is also the beginning of the body
- (end-of-line)
-
- ;; Are we looking at "function Foo\n (paramlist)"
- (skip-chars-forward " \t\n(")
-
- (condition-case nil
- (up-list 1)
- (error nil))
-
- (skip-chars-forward " \t\n")
- (if (looking-at "return")
- (progn
- (forward-word-strictly 1)
- (skip-chars-forward " \t\n")
- (skip-chars-forward "a-zA-Z0-9_'")))
-
- ;; Can't simply do forward-word, in case the "is" is not on the
- ;; same line as the closing parenthesis
- (skip-chars-forward "is \t\n")
-
- ;; No look for the closest subprogram body that has not ended yet.
- ;; Not that we expect all the bodies to be finished by "end <name>",
- ;; or a simple "end;" indented in the same column as the start of
- ;; the subprogram. The goal is to be as efficient as possible.
-
- (while (and (not found)
- (re-search-backward ada-imenu-subprogram-menu-re nil t))
-
- ;; Get the function name, but not the properties, or this changes
- ;; the face in the mode line on Emacs 21
- (setq func-name (match-string-no-properties 3))
- (if (and (not (ada-in-comment-p))
- (not (save-excursion
- (goto-char (match-end 0))
- (looking-at "[ \t\n]*new"))))
- (save-excursion
- (back-to-indentation)
- (setq indent (current-column))
- (if (ada-search-ignore-string-comment
- (concat "end[ \t]+" func-name "[ \t]*;\\|^"
- (make-string indent ? ) "end;"))
- (setq end-pos (point))
- (setq end-pos (point-max)))
- (if (>= end-pos pos)
- (setq found func-name))))
- )
- (setq ada-last-which-function-line line
- ada-last-which-function-subprog found)
- found))))
-
-(defun ada-ff-other-window ()
- "Find other file in other window using `ff-find-other-file'."
- (interactive)
- (and (fboundp 'ff-find-other-file)
- (ff-find-other-file t)))
-
-(defun ada-set-point-accordingly ()
- "Move to the function declaration that was set by
`ff-which-function-are-we-in'."
- (if ff-function-name
- (progn
- (goto-char (point-min))
- (unless (ada-search-ignore-string-comment
- (concat ff-function-name "\\b") nil)
- (goto-char (point-min))))))
-
-(defun ada-get-body-name (&optional spec-name)
- "Return the file name for the body of SPEC-NAME.
-If SPEC-NAME is nil, return the body for the current package.
-Return nil if no body was found."
- (interactive)
-
- (unless spec-name (setq spec-name (buffer-file-name)))
-
- ;; Remove the spec extension. We can not simply remove the file extension,
- ;; but we need to take into account the specific non-GNAT extensions that the
- ;; user might have specified.
-
- (let ((suffixes ada-spec-suffixes)
- end)
- (while suffixes
- (setq end (- (length spec-name) (length (car suffixes))))
- (if (string-equal (car suffixes) (substring spec-name end))
- (setq spec-name (substring spec-name 0 end)))
- (setq suffixes (cdr suffixes))))
-
- ;; If find-file.el was available, use its functions
- (if (fboundp 'ff-get-file-name)
- (ff-get-file-name ada-search-directories-internal
- (ada-make-filename-from-adaname
- (file-name-nondirectory
- (file-name-sans-extension spec-name)))
- ada-body-suffixes)
- ;; Else emulate it very simply
- (concat (ada-make-filename-from-adaname
- (file-name-nondirectory
- (file-name-sans-extension spec-name)))
- ".adb")))
-
-
-;; ---------------------------------------------------
-;; support for font-lock.el
-;; Strings are a real pain in Ada because a single quote character is
-;; overloaded as a string quote and type/instance delimiter. By default, a
-;; single quote is given punctuation syntax in `ada-mode-syntax-table'.
-;; So, for Font Lock mode purposes, we mark single quotes as having string
-;; syntax when the gods that created Ada determine them to be.
-;;
-;; This only works in Emacs. See the comments before the grammar functions
-;; at the beginning of this file for how this is done with XEmacs.
-;; ----------------------------------------------------
-
-(defconst ada-font-lock-syntactic-keywords
- ;; Mark single quotes as having string quote syntax in 'c' instances.
- ;; We used to explicitly avoid ''' as a special case for fear the buffer
- ;; be highlighted as a string, but it seems this fear is unfounded.
- ;;
- ;; This sets the properties of the characters, so that ada-in-string-p
- ;; correctly handles '"' too...
- '(("[^a-zA-Z0-9)]\\('\\)[^\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
- ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
-
-(defvar ada-font-lock-keywords
- (eval-when-compile
- (list
- ;;
- ;; handle "type T is access function return S;"
- (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) )
-
- ;; preprocessor line
- (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-type-face t))
-
- ;;
- ;; accept, entry, function, package (body), protected (body|type),
- ;; pragma, procedure, task (body) plus name.
- (list (concat
- "\\<\\("
- "accept\\|"
- "entry\\|"
- "function\\|"
- "package[ \t]+body\\|"
- "package\\|"
- "pragma\\|"
- "procedure\\|"
- "protected[ \t]+body\\|"
- "protected[ \t]+type\\|"
- "protected\\|"
- "task[ \t]+body\\|"
- "task[ \t]+type\\|"
- "task"
- "\\)\\>[ \t]*"
- "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
- '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))
- ;;
- ;; Optional keywords followed by a type name.
- (list (concat ; ":[ \t]*"
- "\\<\\(access[ \t]+all\\|access[
\t]+constant\\|access\\|constant\\|in[ \t]+reverse\\|\\|in[
\t]+out\\|in\\|out\\)\\>"
- "[ \t]*"
- "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
- '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
-
- ;;
- ;; Main keywords, except those treated specially below.
- (concat "\\<"
- (regexp-opt
- '("abort" "abs" "abstract" "accept" "access" "aliased" "all"
- "and" "array" "at" "begin" "case" "declare" "delay" "delta"
- "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
- "generic" "if" "in" "interface" "is" "limited" "loop" "mod"
"not"
- "null" "or" "others" "overriding" "private" "protected" "raise"
- "range" "record" "rem" "renames" "requeue" "return" "reverse"
- "select" "separate" "synchronized" "tagged" "task" "terminate"
- "then" "until" "when" "while" "with" "xor") t)
- "\\>")
- ;;
- ;; Anything following end and not already fontified is a body name.
- '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?"
- (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
- ;;
- ;; Keywords followed by a type or function name.
- (list (concat "\\<\\("
- "new\\|of\\|subtype\\|type"
- "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
- '(1 font-lock-keyword-face)
- '(2 (if (match-beginning 4)
- font-lock-function-name-face
- font-lock-type-face) nil t))
- ;;
- ;; Keywords followed by a (comma separated list of) reference.
- ;; Note that font-lock only works on single lines, thus we can not
- ;; correctly highlight a with_clause that spans multiple lines.
- (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)"
- "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W")
- '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t))
-
- ;;
- ;; Goto tags.
- '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face)
-
- ;; Highlight based-numbers (R. Reagan <address@hidden>)
- (list "\\([0-9]+#[[:xdigit:]_]+#\\)" '(1 font-lock-constant-face t))
-
- ;; Ada unnamed numerical constants
- (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face))
-
- ))
- "Default expressions to highlight in Ada mode.")
-
-
-;; ---------------------------------------------------------
-;; Support for outline.el
-;; ---------------------------------------------------------
-
-(defun ada-outline-level ()
- "This is so that `current-column' DTRT in otherwise-hidden text."
- ;; patch from Dave Love <address@hidden>
- (let (buffer-invisibility-spec)
- (save-excursion
- (back-to-indentation)
- (current-column))))
-
-;; ---------------------------------------------------------
-;; Support for narrow-to-region
-;; ---------------------------------------------------------
-
-(defun ada-narrow-to-defun (&optional _arg)
- "Make text outside current subprogram invisible.
-The subprogram visible is the one that contains or follow point.
-Optional ARG is ignored.
-Use \\[widen] to go back to the full visibility for the buffer."
-
- (interactive)
- (save-excursion
- (let (end)
- (widen)
- (forward-line 1)
- (ada-previous-procedure)
- (setq end (point-at-bol))
- (ada-move-to-end)
- (end-of-line)
- (narrow-to-region end (point))
- (message
- "Use M-x widen to get back to full visibility in the buffer"))))
-
-;; ---------------------------------------------------------
-;; Automatic generation of code
-;; The Ada mode has a set of function to automatically generate a subprogram
-;; or package body from its spec.
-;; These function only use a primary and basic algorithm, this could use a
-;; lot of improvement.
-;; When the user is using GNAT, we rather use gnatstub to generate an accurate
-;; body.
-;; ----------------------------------------------------------
-
-(defun ada-gen-treat-proc (match)
- "Make dummy body of a procedure/function specification.
-MATCH is a cons cell containing the start and end locations of the last search
-for `ada-procedure-start-regexp'."
- (goto-char (car match))
- (let (func-found procname functype)
- (cond
- ((or (looking-at "^[ \t]*procedure")
- (setq func-found (looking-at "^[ \t]*function")))
- ;; treat it as a proc/func
- (forward-word-strictly 2)
- (forward-word-strictly -1)
- (setq procname (buffer-substring (point) (cdr match))) ; store proc name
-
- ;; goto end of procname
- (goto-char (cdr match))
-
- ;; skip over parameterlist
- (unless (looking-at "[ \t\n]*\\(;\\|return\\)")
- (forward-sexp))
-
- ;; if function, skip over 'return' and result type.
- (if func-found
- (progn
- (forward-word-strictly 1)
- (skip-chars-forward " \t\n")
- (setq functype (buffer-substring (point)
- (progn
- (skip-chars-forward
- "a-zA-Z0-9_.")
- (point))))))
- ;; look for next non WS
- (cond
- ((looking-at "[ \t]*;")
- (delete-region (match-beginning 0) (match-end 0));; delete the ';'
- (ada-indent-newline-indent)
- (insert "is")
- (ada-indent-newline-indent)
- (if func-found
- (progn
- (insert "Result : " functype ";")
- (ada-indent-newline-indent)))
- (insert "begin")
- (ada-indent-newline-indent)
- (if func-found
- (insert "return Result;")
- (insert "null;"))
- (ada-indent-newline-indent)
- (insert "end " procname ";")
- (ada-indent-newline-indent)
- )
-
- ((looking-at "[ \t\n]*is")
- ;; do nothing
- )
-
- ((looking-at "[ \t\n]*rename")
- ;; do nothing
- )
-
- (t
- (message "unknown syntax"))))
- (t
- (if (looking-at "^[ \t]*task")
- (progn
- (message "Task conversion is not yet implemented")
- (forward-word-strictly 2)
- (if (looking-at "[ \t]*;")
- (forward-line)
- (ada-move-to-end))
- ))))))
-
-(defun ada-make-body ()
- "Create an Ada package body in the current buffer.
-The spec must be the previously visited buffer.
-This function typically is to be hooked into `ff-file-created-hook'."
- (delete-region (point-min) (point-max))
- (insert-buffer-substring (car (cdr (buffer-list))))
- (goto-char (point-min))
- (ada-mode)
-
- (let (found ada-procedure-or-package-start-regexp)
- (if (setq found
- (ada-search-ignore-string-comment ada-package-start-regexp nil))
- (progn (goto-char (cdr found))
- (insert " body")
- )
- (error "No package"))
-
- (setq ada-procedure-or-package-start-regexp
- (concat ada-procedure-start-regexp
- "\\|"
- ada-package-start-regexp))
-
- (while (setq found
- (ada-search-ignore-string-comment
- ada-procedure-or-package-start-regexp nil))
- (progn
- (goto-char (car found))
- (if (looking-at ada-package-start-regexp)
- (progn (goto-char (cdr found))
- (insert " body"))
- (ada-gen-treat-proc found))))))
-
-
-(defun ada-make-subprogram-body ()
- "Create a dummy subprogram body in package body file from spec surrounding
point."
- (interactive)
- (let* ((found (re-search-backward ada-procedure-start-regexp nil t))
- (spec (match-beginning 0))
- body-file)
- (if found
- (progn
- (goto-char spec)
- (if (and (re-search-forward "(\\|;" nil t)
- (= (char-before) ?\())
- (progn
- (ada-search-ignore-string-comment ")" nil)
- (ada-search-ignore-string-comment ";" nil)))
- (setq spec (buffer-substring spec (point)))
-
- ;; If find-file.el was available, use its functions
- (setq body-file (ada-get-body-name))
- (if body-file
- (find-file body-file)
- (error "No body found for the package. Create it first"))
-
- (save-restriction
- (widen)
- (goto-char (point-max))
- (forward-comment -10000)
- (re-search-backward "\\<end\\>" nil t)
- ;; Move to the beginning of the elaboration part, if any
- (re-search-backward "^begin" nil t)
- (newline)
- (forward-char -1)
- (insert spec)
- (re-search-backward ada-procedure-start-regexp nil t)
- (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0)))
- ))
- (error "Not in subprogram spec"))))
-
-;; --------------------------------------------------------
-;; Global initializations
-;; --------------------------------------------------------
-
-;; Create the keymap once and for all. If we do that in ada-mode,
-;; the keys changed in the user's .emacs have to be modified
-;; every time
-(ada-create-keymap)
-(ada-create-menu)
-
-;; Add the default extensions (and set up speedbar)
-(ada-add-extensions ".ads" ".adb")
-;; This two files are generated by GNAT when running with -gnatD
-(if (equal ada-which-compiler 'gnat)
- (ada-add-extensions ".ads.dg" ".adb.dg"))
-
-;; Read the special cases for exceptions
-(ada-case-read-exceptions)
-
-;; Setup auto-loading of the other Ada mode files.
-(autoload 'ada-change-prj "ada-xref" nil t)
-(autoload 'ada-check-current "ada-xref" nil t)
-(autoload 'ada-compile-application "ada-xref" nil t)
-(autoload 'ada-compile-current "ada-xref" nil t)
-(autoload 'ada-complete-identifier "ada-xref" nil t)
-(autoload 'ada-find-file "ada-xref" nil t)
-(autoload 'ada-find-any-references "ada-xref" nil t)
-(autoload 'ada-find-src-file-in-dir "ada-xref" nil t)
-(autoload 'ada-find-local-references "ada-xref" nil t)
-(autoload 'ada-find-references "ada-xref" nil t)
-(autoload 'ada-gdb-application "ada-xref" nil t)
-(autoload 'ada-goto-declaration "ada-xref" nil t)
-(autoload 'ada-goto-declaration-other-frame "ada-xref" nil t)
-(autoload 'ada-goto-parent "ada-xref" nil t)
-(autoload 'ada-make-body-gnatstub "ada-xref" nil t)
-(autoload 'ada-point-and-xref "ada-xref" nil t)
-(autoload 'ada-reread-prj-file "ada-xref" nil t)
-(autoload 'ada-run-application "ada-xref" nil t)
-(autoload 'ada-set-default-project-file "ada-xref" nil t)
-(autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
-(autoload 'ada-set-main-compile-application "ada-xref" nil t)
-(autoload 'ada-show-current-main "ada-xref" nil t)
-
-(autoload 'ada-customize "ada-prj" nil t)
-(autoload 'ada-prj-edit "ada-prj" nil t)
-(autoload 'ada-prj-new "ada-prj" nil t)
-(autoload 'ada-prj-save "ada-prj" nil t)
-
-(autoload 'ada-array "ada-stmt" nil t)
-(autoload 'ada-case "ada-stmt" nil t)
-(autoload 'ada-declare-block "ada-stmt" nil t)
-(autoload 'ada-else "ada-stmt" nil t)
-(autoload 'ada-elsif "ada-stmt" nil t)
-(autoload 'ada-exception "ada-stmt" nil t)
-(autoload 'ada-exception-block "ada-stmt" nil t)
-(autoload 'ada-exit "ada-stmt" nil t)
-(autoload 'ada-for-loop "ada-stmt" nil t)
-(autoload 'ada-function-spec "ada-stmt" nil t)
-(autoload 'ada-header "ada-stmt" nil t)
-(autoload 'ada-if "ada-stmt" nil t)
-(autoload 'ada-loop "ada-stmt" nil t)
-(autoload 'ada-package-body "ada-stmt" nil t)
-(autoload 'ada-package-spec "ada-stmt" nil t)
-(autoload 'ada-private "ada-stmt" nil t)
-(autoload 'ada-procedure-spec "ada-stmt" nil t)
-(autoload 'ada-record "ada-stmt" nil t)
-(autoload 'ada-subprogram-body "ada-stmt" nil t)
-(autoload 'ada-subtype "ada-stmt" nil t)
-(autoload 'ada-tabsize "ada-stmt" nil t)
-(autoload 'ada-task-body "ada-stmt" nil t)
-(autoload 'ada-task-spec "ada-stmt" nil t)
-(autoload 'ada-type "ada-stmt" nil t)
-(autoload 'ada-use "ada-stmt" nil t)
-(autoload 'ada-when "ada-stmt" nil t)
-(autoload 'ada-while-loop "ada-stmt" nil t)
-(autoload 'ada-with "ada-stmt" nil t)
-
-;;; provide ourselves
-(provide 'ada-mode)
-
-;;; ada-mode.el ends here
diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el
deleted file mode 100644
index d9fa77c..0000000
--- a/lisp/progmodes/ada-prj.el
+++ /dev/null
@@ -1,682 +0,0 @@
-;;; ada-prj.el --- GUI editing of project files for the ada-mode
-
-;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
-
-;; Author: Emmanuel Briot <address@hidden>
-;; Maintainer: Stephen Leake <address@hidden>
-;; Keywords: languages, ada, project file
-;; Package: ada-mode
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package provides a set of functions to easily edit the project
-;; files used by the ada-mode.
-;; The only function publicly available here is `ada-customize'.
-;; See the documentation of the Ada mode for more information on the project
-;; files.
-;; Internally, a project file is represented as a property list, with each
-;; field of the project file matching one property of the list.
-
-;;; Code:
-
-
-;; ----- Requirements -----------------------------------------------------
-
-(require 'cus-edit)
-(require 'ada-xref)
-
-(eval-when-compile
- (require 'ada-mode))
-(eval-when-compile (require 'cl-lib))
-
-;; ----- Buffer local variables -------------------------------------------
-
-(defvar ada-prj-current-values nil
- "Hold the current value of the fields, This is a property list.")
-(make-variable-buffer-local 'ada-prj-current-values)
-
-(defvar ada-prj-default-values nil
- "Hold the default value for the fields, This is a property list.")
-(make-variable-buffer-local 'ada-prj-default-values)
-
-(defvar ada-prj-ada-buffer nil
- "Indicates what Ada source file was being edited.")
-
-(defvar ada-old-cross-prefix nil
- "The cross-prefix associated with the currently loaded runtime library.")
-
-
-;; ----- Functions --------------------------------------------------------
-
-(defun ada-prj-new ()
- "Open a new project file."
- (interactive)
- (let* ((prj
- (if (and ada-prj-default-project-file
- (not (string= ada-prj-default-project-file "")))
- ada-prj-default-project-file
- "default.adp"))
- (filename (read-file-name "Project file: "
- (if prj "" nil)
- nil
- nil
- prj)))
- (if (not (string= (file-name-extension filename t) ".adp"))
- (error "File name extension for project files must be .adp"))
-
- (ada-customize nil filename)))
-
-(defun ada-prj-edit ()
- "Editing the project file associated with the current Ada buffer.
-If there is none, opens a new project file."
- (interactive)
- (if ada-prj-default-project-file
- (ada-customize)
- (ada-prj-new)))
-
-(defun ada-prj-initialize-values (symbol _ada-buffer filename)
- "Set SYMBOL to the property list of the project file FILENAME.
-If FILENAME is null, read the file associated with ADA-BUFFER.
-If no project file is found, return the default values."
-;; FIXME: rationalize arguments; make ada-buffer optional?
- (if (and filename
- (not (string= filename ""))
- (assoc filename ada-xref-project-files))
- (set symbol (copy-sequence (cdr (assoc filename
ada-xref-project-files))))
-
- ;; Set default values (except for the file name if this was given
- ;; in the buffer
- (set symbol (ada-default-prj-properties))
- (if (and filename (not (string= filename "")))
- (set symbol (plist-put (eval symbol) 'filename filename)))
- ))
-
-
-(defun ada-prj-save-specific-option (field)
- "Return the string to print in the project file to save FIELD.
-If the current value of FIELD is the default value, return an empty string."
- (if (string= (plist-get ada-prj-current-values field)
- (plist-get ada-prj-default-values field))
- ""
- (concat (symbol-name field)
- "=" (plist-get ada-prj-current-values field) "\n")))
-
-(defun ada-prj-save ()
- "Save the edited project file."
- (interactive)
- (let ((file-name (or (plist-get ada-prj-current-values 'filename)
- (read-file-name "Save project as: ")))
- output)
- (setq output
- (concat
-
- ;; Save the fields that do not depend on the current buffer
- ;; only if they are different from the default value
-
- (ada-prj-save-specific-option 'comp_opt)
- (ada-prj-save-specific-option 'bind_opt)
- (ada-prj-save-specific-option 'link_opt)
- (ada-prj-save-specific-option 'gnatmake_opt)
- (ada-prj-save-specific-option 'gnatfind_opt)
- (ada-prj-save-specific-option 'cross_prefix)
- (ada-prj-save-specific-option 'remote_machine)
- (ada-prj-save-specific-option 'debug_cmd)
-
- ;; Always save the fields that depend on the current buffer
- "main=" (plist-get ada-prj-current-values 'main) "\n"
- "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n"
- (ada-prj-set-list "check_cmd"
- (plist-get ada-prj-current-values 'check_cmd)) "\n"
- (ada-prj-set-list "make_cmd"
- (plist-get ada-prj-current-values 'make_cmd)) "\n"
- (ada-prj-set-list "comp_cmd"
- (plist-get ada-prj-current-values 'comp_cmd)) "\n"
- (ada-prj-set-list "run_cmd"
- (plist-get ada-prj-current-values 'run_cmd)) "\n"
- (ada-prj-set-list "src_dir"
- (plist-get ada-prj-current-values 'src_dir)
- t) "\n"
- (ada-prj-set-list "obj_dir"
- (plist-get ada-prj-current-values 'obj_dir)
- t) "\n"
- (ada-prj-set-list "debug_pre_cmd"
- (plist-get ada-prj-current-values 'debug_pre_cmd))
- "\n"
- (ada-prj-set-list "debug_post_cmd"
- (plist-get ada-prj-current-values 'debug_post_cmd))
- "\n"
- ))
-
- (find-file file-name)
- (erase-buffer)
- (insert output)
- (save-buffer)
- ;; kill the project buffer
- (kill-buffer nil)
-
- ;; kill the editor buffer
- (kill-buffer "*Edit Ada Mode Project*")
-
- ;; automatically set the new project file as the active one
- (setq ada-prj-default-project-file file-name)
-
- ;; force Emacs to reread the project files
- (ada-reread-prj-file file-name)
- )
- )
-
-(defun ada-prj-load-from-file (symbol)
- "Load SYMBOL value from file.
-One item per line should be found in the file."
- (save-excursion
- (let ((file (read-file-name "File name: " nil nil t))
- (buffer (current-buffer))
- line
- list)
- (find-file file)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (setq line (buffer-substring-no-properties (point) (point-at-eol)))
- (cl-pushnew line list :test #'equal)
- (forward-line 1))
- (kill-buffer nil)
- (set-buffer buffer)
- (setq ada-prj-current-values
- (plist-put ada-prj-current-values
- symbol
- (append (plist-get ada-prj-current-values symbol)
- (reverse list)))))
- (ada-prj-display-page 2)))
-
-(defun ada-prj-subdirs-of (dir)
- "Return a list of all the subdirectories of DIR, recursively."
- (let ((subdirs (directory-files dir t "^[^.].*"))
- (dirlist (list dir)))
- (while subdirs
- (if (file-directory-p (car subdirs))
- (let ((sub (ada-prj-subdirs-of (car subdirs))))
- (if sub
- (setq dirlist (append sub dirlist)))))
- (setq subdirs (cdr subdirs)))
- dirlist))
-
-(defun ada-prj-load-directory (field &optional file-name)
- "Append to FIELD in the current project the subdirectories of FILE-NAME.
-If FILE-NAME is nil, ask the user for the name."
-
- ;; Do not use an external dialog for this, since it wouldn't allow
- ;; the user to select a directory
- (let ((use-dialog-box nil))
- (unless file-name
- (setq file-name (read-directory-name "Root directory: " nil nil t))))
-
- (setq ada-prj-current-values
- (plist-put ada-prj-current-values
- field
- (append (plist-get ada-prj-current-values field)
- (reverse (ada-prj-subdirs-of
- (expand-file-name file-name))))))
- (ada-prj-display-page 2))
-
-(defun ada-prj-display-page (tab-num)
- "Display page TAB-NUM in the notebook.
-The current buffer must be the project editing buffer."
-
- (let ((inhibit-read-only t))
- (erase-buffer))
-
- ;; Widget support in Emacs 21 requires that we clear the buffer first
- (if (and (not (featurep 'xemacs)) (>= emacs-major-version 21))
- (progn
- (setq widget-field-new nil
- widget-field-list nil)
- (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists)))
- (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
-
- ;; Display the tabs
-
- (widget-insert "\n Project configuration.\n
- ___________ ____________ ____________ ____________
____________\n / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 1)) "General")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 2)) "Paths")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 3)) "Switches")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 4)) "Ada Menu")
- (widget-insert " \\ / ")
- (widget-create 'push-button :notify
- (lambda (&rest _dummy) (ada-prj-display-page 5)) "Debugger")
- (widget-insert " \\\n")
-
- ;; Display the currently selected page
-
- (cond
-
- ;;
- ;; First page (General)
- ;;
- ((= tab-num 1)
- (widget-insert "/
\\/______________\\/______________\\/______________\\/______________\\\n")
-
- (widget-insert "Project file name:\n")
- (widget-insert (plist-get ada-prj-current-values 'filename))
- (widget-insert "\n\n")
- (ada-prj-field 'casing "Casing Exceptions"
-"List of files that contain casing exception
-dictionaries. All these files contain one
-identifier per line, with a special casing.
-The first file has the highest priority."
- t nil
- (mapconcat (lambda(x)
- (concat " " x))
- (ada-xref-get-project-field 'casing)
- "\n")
- )
- (ada-prj-field 'main "Executable file name"
-"Name of the executable generated when you
-compile your application. This should include
-the full directory name, using ${build_dir} if
-you wish.")
- (ada-prj-field 'build_dir "Build directory"
- "Reference directory for relative paths in
-src_dir and obj_dir below. This is also the directory
-where the compilation is done.")
- (ada-prj-field 'remote_machine "Name of the remote machine (if any)"
-"If you want to remotely compile, debug and
-run your application, specify the name of a
-remote machine here. This capability requires
-the `rsh' protocol on the remote machine.")
- (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain"
-"When working on multiple cross targets, it is
-most convenient to specify the prefix of the
-tool chain here. For instance, on PowerPc
-vxworks, you would enter `powerpc-wrs-vxworks-'.
-To use JGNAT, enter `j'.")
- )
-
-
- ;;
- ;; Second page (Paths)
- ;;
- ((= tab-num 2)
- (if (not (equal (plist-get ada-prj-current-values 'cross_prefix)
- ada-old-cross-prefix))
- (progn
- (setq ada-old-cross-prefix
- (plist-get ada-prj-current-values 'cross_prefix))
- (ada-initialize-runtime-library ada-old-cross-prefix)))
-
-
- (widget-insert "/_____________\\/
\\/______________\\/______________\\/______________\\\n")
- (ada-prj-field 'src_dir "Source directories"
-"Enter the list of directories where your Ada
-sources can be found. These directories will be
-used for the cross-references and for the default
-compilation commands.
-Note that src_dir includes both the build directory
-and the standard runtime."
- t t
- (mapconcat (lambda(x)
- (concat " " x))
- ada-xref-runtime-library-specs-path
- "\n")
- )
- (widget-insert "\n\n")
-
- (ada-prj-field 'obj_dir "Object directories"
-"Enter the list of directories where the GNAT
-library files (ALI files) can be found. These
-files are used for cross-references and by the
-gnatmake command.
-Note that obj_dir includes both the build directory
-and the standard runtime."
- t t
- (mapconcat (lambda(x)
- (concat " " x))
- ada-xref-runtime-library-ali-path
- "\n")
- )
- (widget-insert "\n\n")
- )
-
- ;;
- ;; Third page (Switches)
- ;;
- ((= tab-num 3)
- (widget-insert "/_____________\\/______________\\/
\\/______________\\/______________\\\n")
- (ada-prj-field 'comp_opt "Switches for the compiler"
-"These switches are used in the default
-compilation commands, both for compiling a
-single file and rebuilding the whole project")
- (ada-prj-field 'bind_opt "Switches for the binder"
-"These switches are used in the default build
-command and are passed to the binder")
- (ada-prj-field 'link_opt "Switches for the linker"
-"These switches are used in the default build
-command and are passed to the linker")
- (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
-"These switches are used in the default gnatmake
-command.")
- (ada-prj-field 'gnatfind_opt "Switches for gnatfind"
-"The command gnatfind is run every time the Ada/Goto/List_References menu.
-You should for instance add -a if you are working in an environment
-where most ALI files are write-protected, since otherwise they get
-ignored by gnatfind and you don't see the references within.")
- )
-
- ;;
- ;; Fourth page
- ;;
- ((= tab-num 4)
- (widget-insert "/_____________\\/______________\\/______________\\/
\\/______________\\\n")
- (widget-insert
-"All the fields below can use variable substitution. The syntax is ${name},
-where name is the name that appears after the Help buttons in this buffer. As
-a special case, ${current} is replaced with the name of the file currently
-edited, with directory name but no extension, whereas ${full_current} is
-replaced with the name of the current file with directory name and
-extension.\n")
- (widget-insert
-"The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to
-${src_dir} and ${obj_dir} before running the compilation commands, so that you
-don't need to specify the -aI and -aO switches on the command line\n")
- (widget-insert
-"You can reference any environment variable using the same ${...} syntax as
-above, and put the name of the variable between the quotes.\n\n")
- (ada-prj-field 'check_cmd
- "Check syntax of a single file (menu Ada->Check File)"
-"This command is run to check the syntax and semantics of a file.
-The file name is added at the end of this command." t)
- (ada-prj-field 'comp_cmd
- "Compiling a single file (menu Ada->Compile File)"
-"This command is run when the recompilation
-of a single file is needed. The file name is
-added at the end of this command." t)
- (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)"
-"This command is run when you want to rebuild
-your whole application. It is never issues
-automatically and you will need to ask for it.
-If remote_machine has been set, this command
-will be executed on the remote machine." t)
- (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)"
-"This command specifies how to run the
-application, including any switch you need to
-specify. If remote_machine has been set, this
-command will be executed on the remote host." t)
- )
-
- ;;
- ;; Fifth page
- ;;
- ((= tab-num 5)
- (widget-insert
"/_____________\\/______________\\/______________\\/______________\\/
\\\n")
- (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the
-debugger"
-"The following commands are executed one after the other before starting
-the debugger. These can be used to set up your environment." t)
-
- (ada-prj-field 'debug_cmd "Debugging the application"
-"Specifies how to debug the application, possibly
-remotely if remote_machine has been set. We
-recommend the following debuggers:
- > gdb
- > gvd --tty
- > ddd --tty -fullname -toolbar")
-
- (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger"
-"The following commands are executed one in the debugger once it has been
-started. These can be used to initialize the debugger, for instance to
-connect to the target when working with cross-environments" t)
- )
-
- )
-
-
- (widget-insert
"______________________________________________________________________\n\n
")
- (widget-create 'push-button
- :notify (lambda (&rest _ignore)
- (setq ada-prj-current-values
(ada-default-prj-properties))
- (ada-prj-display-page 1))
- "Reset to Default Values")
- (widget-insert " ")
- (widget-create 'push-button :notify (lambda (&rest _ignore) (kill-buffer
nil))
- "Cancel")
- (widget-insert " ")
- (widget-create 'push-button :notify (lambda (&rest _ignore) (ada-prj-save))
- "Save")
- (widget-insert "\n\n")
-
- (widget-setup)
- (with-no-warnings
- (beginning-of-buffer))
- )
-
-
-(defun ada-customize (&optional new-file filename)
- "Edit the project file associated with the current buffer.
-If there is none or NEW-FILE is non-nil, make a new one.
-If FILENAME is given, edit that file."
- (interactive)
-
- (let ((ada-buffer (current-buffer))
- (inhibit-read-only t))
-
- ;; We can only edit interactively the standard ada-mode project files. If
- ;; the user is using other formats for the project file (through hooks in
- ;; `ada-load-project-hook', we simply edit the file
-
- (if (and (not new-file)
- (or ada-prj-default-project-file filename)
- (string= (file-name-extension
- (or filename ada-prj-default-project-file))
- "gpr"))
- (progn
- (find-file ada-prj-default-project-file)
- (add-hook 'after-save-hook 'ada-reread-prj-file t t)
- )
-
- (if filename
- (ada-reread-prj-file filename)
- (if (not (string= ada-prj-default-project-file ""))
- (ada-reread-prj-file ada-prj-default-project-file)
- (ada-reread-prj-file)))
-
- (switch-to-buffer "*Edit Ada Mode Project*")
-
- (ada-prj-initialize-values 'ada-prj-current-values
- ada-buffer
- ada-prj-default-project-file)
-
- (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
-
- (use-local-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map custom-mode-map)
- (define-key map "\C-x\C-s" 'ada-prj-save)
- map))
-
- ;; FIXME: Not sure if this works!!
- (set (make-local-variable 'widget-keymap)
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map "\C-x\C-s" 'ada-prj-save)
- map))
-
- (set (make-local-variable 'ada-old-cross-prefix)
- (ada-xref-get-project-field 'cross-prefix))
-
- (ada-prj-display-page 1)
- )))
-
-;; ---------------- Utilities --------------------------------
-
-(defun ada-prj-set-list (string ada-list &optional is-directory)
- "Prepend STRING to strings in ADA-LIST, return new-line separated string.
-If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly
-converted to a directory name."
-
- (mapconcat (lambda (x) (concat string "="
- (if is-directory
- (file-name-as-directory x)
- x)))
- ada-list "\n"))
-
-
-(defun ada-prj-field-modified (widget &rest _dummy)
- "Callback for modification of WIDGET.
-Remaining args DUMMY are ignored.
-Save the change in `ada-prj-current-values' so that selecting
-another page and coming back keeps the new value."
- (setq ada-prj-current-values
- (plist-put ada-prj-current-values
- (widget-get widget ':prj-field)
- (widget-value widget))))
-
-(defun ada-prj-display-help (widget _widget-modified event)
- "Callback for help button in WIDGET.
-Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
- (let ((text (widget-get widget 'prj-help)))
- (if event
- ;; If we have a mouse-event, popup a menu
- (widget-choose "Help"
- (mapcar (lambda (a) (cons a t))
- (split-string text "\n"))
- event)
- ;; Else display the help string just before the next group of
- ;; variables
- (momentary-string-display
- (concat "*****Help*****\n" text "\n**************\n")
- (point-at-bol 2)))))
-
-(defun ada-prj-show-value (widget _widget-modified event)
- "Show the current field value in WIDGET.
-Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
- (let* ((field (widget-get widget ':prj-field))
- (value (plist-get ada-prj-current-values field))
- (inhibit-read-only t)
- w)
-
- ;; If the other widget is already visible, delete it
- (if (widget-get widget 'prj-other-widget)
- (progn
- (widget-delete (widget-get widget 'prj-other-widget))
- (widget-put widget 'prj-other-widget nil)
- (widget-put widget ':prj-field field)
- (widget-default-value-set widget "Show Value")
- )
-
- ;; Else create it
- (save-excursion
- (mouse-set-point event)
- (forward-line 1)
- (beginning-of-line)
- (setq w (widget-create 'editable-list
- :entry-format "%i%d %v"
- :notify 'ada-prj-field-modified
- :help-echo (widget-get widget 'prj-help)
- :value value
- (list 'editable-field :keymap widget-keymap)))
- (widget-put widget 'prj-other-widget w)
- (widget-put w ':prj-field field)
- (widget-put widget ':prj-field field)
- (widget-default-value-set widget "Hide Value")
- )
- )
- (widget-setup)
- ))
-
-(defun ada-prj-field (field text help-text &optional is-list is-paths
after-text)
- "Create a widget to edit FIELD in the current buffer.
-TEXT is a short explanation of what the field means, whereas HELP-TEXT
-is the text displayed when the user pressed the help button.
-If IS-LIST is non-nil, the field contains a list. Otherwise, it contains
-a single string.
-If IS-PATHS is true, some special buttons are added to load paths,...
-AFTER-TEXT is inserted just after the widget."
- (let ((value (plist-get ada-prj-current-values field))
- (inhibit-read-only t)
- widget)
- (unless value
- (setq value
- (if is-list '() "")))
- (widget-insert text)
- (widget-insert ":")
- (move-to-column 54 t)
- (widget-put (widget-create 'push-button
- :notify 'ada-prj-display-help
- "Help")
- 'prj-help
- help-text)
- (widget-insert (concat " (" (symbol-name field) ")\n"))
- (if is-paths
- (progn
- (widget-create 'push-button
- :notify
- (list 'lambda '(&rest dummy) '(interactive)
- (list 'ada-prj-load-from-file
- (list 'quote field)))
- "Load From File")
- (widget-insert " ")
- (widget-create 'push-button
- :notify
- (list 'lambda '(&rest dummy) '(interactive)
- (list 'ada-prj-load-directory
- (list 'quote field)))
- "Load Recursive Directory")
- (widget-insert "\n ${build_dir}\n")))
-
- (setq widget
- (if is-list
- (if (< (length value) 15)
- (widget-create 'editable-list
- :entry-format "%i%d %v"
- :notify 'ada-prj-field-modified
- :help-echo help-text
- :value value
- (list 'editable-field :keymap widget-keymap))
-
- (let ((w (widget-create 'push-button
- :notify 'ada-prj-show-value
- "Show value")))
- (widget-insert "\n")
- (widget-put w 'prj-help help-text)
- (widget-put w 'prj-other-widget nil)
- w)
- )
- (widget-create 'editable-field
- :format "%v"
- :notify 'ada-prj-field-modified
- :help-echo help-text
- :keymap widget-keymap
- value)))
- (widget-put widget ':prj-field field)
- (if after-text
- (widget-insert after-text))
- (widget-insert "\n")
- ))
-
-
-(provide 'ada-prj)
-
-;;; ada-prj.el ends here
diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el
deleted file mode 100644
index ef42b0d..0000000
--- a/lisp/progmodes/ada-stmt.el
+++ /dev/null
@@ -1,486 +0,0 @@
-;;; ada-stmt.el --- an extension to Ada mode for inserting statement templates
-
-;; Copyright (C) 1987, 1993-1994, 1996-2019 Free Software Foundation,
-;; Inc.
-
-;; Authors: Daniel Pfeiffer
-;; Markus Heritsch
-;; Rolf Ebert <address@hidden>
-;; Maintainer: Stephen Leake <address@hidden>
-;; Keywords: languages, ada
-;; Package: ada-mode
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; This file is now automatically loaded from ada-mode.el, and creates a
submenu
-;; in Ada/ on the menu bar.
-
-;;; History:
-
-;; Created May 1987.
-;; Original version from V. Bowman as in ada.el of Emacs-18
-;; (borrowed heavily from Mick Jordan's Modula-2 package for GNU,
-;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
-;;
-;; Sep 1993. Daniel Pfeiffer <address@hidden> (DP)
-;; Introduced statement.el for smaller code and user configurability.
-;;
-;; Nov 1993. Rolf Ebert <address@hidden> (RE) Moved the
-;; skeleton generation into this separate file. The code still is
-;; essentially written by DP
-;;
-;; Adapted Jun 1994. Markus Heritsch
-;; <address@hidden> (MH)
-;; added menu bar support for templates
-;;
-;; 1994/12/02 Christian Egli <address@hidden>
-;; General cleanup and bug fixes.
-;;
-;; 1995/12/20 John Hutchison <address@hidden>
-;; made it work with skeleton.el from Emacs-19.30. Several
-;; enhancements and bug fixes.
-
-;; BUGS:
-;;;> I have the following suggestions for the function template: 1) I
-;;;> don't want it automatically assigning it a name for the return variable. I
-;;;> never want it to be called "Result" because that is nondescript. If you
-;;;> must define a variable, give me the ability to specify its name.
-;;;>
-;;;> 2) You do not provide a type for variable 'Result'. Its type is the same
-;;;> as the function's return type, which the template knows, so why force me
-;;;> to type it in?
-;;;>
-
-;;;It would be nice if one could configure such layout details separately
-;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el
-;;;could be taken even further, providing the user with some nice syntax
-;;;for describing layout. Then my own hacks would survive the next
-;;;update of the package :-)
-
-
-;;; Code:
-
-(require 'skeleton nil t)
-(require 'easymenu)
-(require 'ada-mode)
-
-(defun ada-func-or-proc-name ()
- "Return the name of the current function or procedure."
- (save-excursion
- (let ((case-fold-search t))
- (if (re-search-backward ada-procedure-start-regexp nil t)
- (match-string 5)
- "NAME?"))))
-
-;;; ---- statement skeletons ------------------------------------------
-
-(define-skeleton ada-array
- "Insert array type definition.
-Prompt for component type and index subtypes."
- ()
- "array (" ("index definition: " str ", " ) -2 ") of " _ ?\;)
-
-
-(define-skeleton ada-case
- "Build skeleton case statement.
-Prompt for the selector expression. Also builds the first when clause."
- "[selector expression]: "
- "case " str " is" \n
- > "when " ("discrete choice: " str " | ") -3 " =>" \n
- > _ \n
- < < "end case;")
-
-
-(define-skeleton ada-when
- "Start a case statement alternative with a when clause."
- ()
- < "when " ("discrete choice: " str " | ") -3 " =>" \n
- >)
-
-
-(define-skeleton ada-declare-block
- "Insert a block with a declare part.
-Indent for the first declaration."
- "[block name]: "
- < str & ?: & \n
- > "declare" \n
- > _ \n
- < "begin" \n
- > \n
- < "end " str | -1 ?\;)
-
-
-(define-skeleton ada-exception-block
- "Insert a block with an exception part.
-Indent for the first line of code."
- "[block name]: "
- < str & ?: & \n
- > "begin" \n
- > _ \n
- < "exception" \n
- > \n
- < "end " str | -1 ?\;)
-
-
-(define-skeleton ada-exception
- "Insert an indented exception part into a block."
- ()
- < "exception" \n
- >)
-
-
-(define-skeleton ada-exit-1
- "Insert then exit condition of the exit statement, prompting for condition."
- "[exit condition]: "
- "when " str | -5)
-
-
-(define-skeleton ada-exit
- "Insert an exit statement, prompting for loop name and condition."
- "[name of loop to exit]: "
- "exit " str & ?\ (ada-exit-1) | -1 ?\;)
-
-;;;###autoload
-(defun ada-header ()
- "Insert a descriptive header at the top of the file."
- (interactive "*")
- (save-excursion
- (goto-char (point-min))
- (if (fboundp 'make-header)
- (funcall (symbol-function 'make-header))
- (ada-header-tmpl))))
-
-
-(define-skeleton ada-header-tmpl
- "Insert a comment block containing the module title, author, etc."
- "[Description]: "
- "-- -*- Mode: Ada -*-"
- "\n" ada-fill-comment-prefix "Filename : " (buffer-name)
- "\n" ada-fill-comment-prefix "Description : " str
- "\n" ada-fill-comment-prefix "Author : " (user-full-name)
- "\n" ada-fill-comment-prefix "Created On : " (current-time-string)
- "\n" ada-fill-comment-prefix "Last Modified By: ."
- "\n" ada-fill-comment-prefix "Last Modified On: ."
- "\n" ada-fill-comment-prefix "Update Count : 0"
- "\n" ada-fill-comment-prefix "Status : Unknown, Use with caution!"
- "\n")
-
-
-(define-skeleton ada-display-comment
- "Inserts three comment lines, making a display comment."
- ()
- "--\n" ada-fill-comment-prefix _ "\n--")
-
-
-(define-skeleton ada-if
- "Insert skeleton if statement, prompting for a boolean-expression."
- "[condition]: "
- "if " str " then" \n
- > _ \n
- < "end if;")
-
-
-(define-skeleton ada-elsif
- "Add an elsif clause to an if statement,
-prompting for the boolean-expression."
- "[condition]: "
- < "elsif " str " then" \n
- >)
-
-
-(define-skeleton ada-else
- "Add an else clause inside an if-then-end-if clause."
- ()
- < "else" \n
- >)
-
-
-(define-skeleton ada-loop
- "Insert a skeleton loop statement. The exit statement is added by hand."
- "[loop name]: "
- < str & ?: & \n
- > "loop" \n
- > _ \n
- < "end loop " str | -1 ?\;)
-
-
-(define-skeleton ada-for-loop-prompt-variable
- "Prompt for the loop variable."
- "[loop variable]: "
- str)
-
-
-(define-skeleton ada-for-loop-prompt-range
- "Prompt for the loop range."
- "[loop range]: "
- str)
-
-
-(define-skeleton ada-for-loop
- "Build a skeleton for-loop statement, prompting for the loop parameters."
- "[loop name]: "
- < str & ?: & \n
- > "for "
- (ada-for-loop-prompt-variable)
- " in "
- (ada-for-loop-prompt-range)
- " loop" \n
- > _ \n
- < "end loop " str | -1 ?\;)
-
-
-(define-skeleton ada-while-loop-prompt-entry-condition
- "Prompt for the loop entry condition."
- "[entry condition]: "
- str)
-
-
-(define-skeleton ada-while-loop
- "Insert a skeleton while loop statement."
- "[loop name]: "
- < str & ?: & \n
- > "while "
- (ada-while-loop-prompt-entry-condition)
- " loop" \n
- > _ \n
- < "end loop " str | -1 ?\;)
-
-
-(define-skeleton ada-package-spec
- "Insert a skeleton package specification."
- "[package name]: "
- "package " str " is" \n
- > _ \n
- < "end " str ?\;)
-
-
-(define-skeleton ada-package-body
- "Insert a skeleton package body -- includes a begin statement."
- "[package name]: "
- "package body " str " is" \n
- > _ \n
-; < "begin" \n
- < "end " str ?\;)
-
-
-(define-skeleton ada-private
- "Undent and start a private section of a package spec. Reindent."
- ()
- < "private" \n
- >)
-
-
-(define-skeleton ada-function-spec-prompt-return
- "Prompts for function result type."
- "[result type]: "
- str)
-
-
-(define-skeleton ada-function-spec
- "Insert a function specification. Prompts for name and arguments."
- "[function name]: "
- "function " str
- " (" ("[parameter_specification]: " str "; " ) -2 ")"
- " return "
- (ada-function-spec-prompt-return)
- ";" \n )
-
-
-(define-skeleton ada-procedure-spec
- "Insert a procedure specification, prompting for its name and arguments."
- "[procedure name]: "
- "procedure " str
- " (" ("[parameter_specification]: " str "; " ) -2 ")"
- ";" \n )
-
-
-(define-skeleton ada-subprogram-body
- "Insert frame for subprogram body.
-Invoke right after `ada-function-spec' or `ada-procedure-spec'."
- ()
- ;; Remove `;' from subprogram decl
- (save-excursion
- (let ((pos (1+ (point))))
- (ada-search-ignore-string-comment ada-subprog-start-re t nil)
- (when (ada-search-ignore-string-comment "(" nil pos t 'search-forward)
- (backward-char 1)
- (forward-sexp 1)))
- (if (looking-at ";")
- (delete-char 1)))
- " is" \n
- _ \n
- < "begin" \n
- \n
- < "exception" \n
- "when others => null;" \n
- < < "end "
- (ada-func-or-proc-name)
- ";" \n)
-
-
-(define-skeleton ada-separate
- "Finish a body stub with `separate'."
- ()
- > "separate;" \n
- <)
-
-
-;(define-skeleton ada-with
-; "Inserts a with clause, prompting for the list of units depended upon."
-; "[list of units depended upon]: "
-; "with " str ?\;)
-
-;(define-skeleton ada-use
-; "Inserts a use clause, prompting for the list of packages used."
-; "[list of packages used]: "
-; "use " str ?\;)
-
-
-(define-skeleton ada-record
- "Insert a skeleton record type declaration."
- ()
- "record" \n
- > _ \n
- < "end record;")
-
-
-(define-skeleton ada-subtype
- "Start insertion of a subtype declaration, prompting for the subtype name."
- "[subtype name]: "
- "subtype " str " is " _ ?\;
- (not (message "insert subtype indication.")))
-
-
-(define-skeleton ada-type
- "Start insertion of a type declaration, prompting for the type name."
- "[type name]: "
- "type " str ?\(
- ("[discriminant specs]: " str " ")
- | (backward-delete-char 1) | ?\)
- " is "
- (not (message "insert type definition.")))
-
-
-(define-skeleton ada-task-body
- "Insert a task body, prompting for the task name."
- "[task name]: "
- "task body " str " is\n"
- "begin\n"
- > _ \n
- < "end " str ";" )
-
-
-(define-skeleton ada-task-spec
- "Insert a task specification, prompting for the task name."
- "[task name]: "
- "task " str
- " (" ("[discriminant]: " str "; ") ") is\n"
- > "entry " _ \n
- <"end " str ";" )
-
-
-(define-skeleton ada-get-param1
- "Prompt for arguments and if any enclose them in brackets."
- ()
- ("[parameter_specification]: " str "; " ) & -2 & ")")
-
-
-(define-skeleton ada-get-param
- "Prompt for arguments and if any enclose them in brackets."
- ()
- " ("
- (ada-get-param1) | -2)
-
-
-(define-skeleton ada-entry
- "Insert a task entry, prompting for the entry name."
- "[entry name]: "
- "entry " str
- (ada-get-param)
- ";" \n)
-
-
-(define-skeleton ada-entry-family-prompt-discriminant
- "Insert an entry specification, prompting for the entry name."
- "[discriminant name]: "
- str)
-
-
-(define-skeleton ada-entry-family
- "Insert an entry specification, prompting for the entry name."
- "[entry name]: "
- "entry " str
- " (" (ada-entry-family-prompt-discriminant) ")"
- (ada-get-param)
- ";" \n)
-
-
-(define-skeleton ada-select
- "Insert a select block."
- ()
- "select\n"
- > _ \n
- < "end select;")
-
-
-(define-skeleton ada-accept-1
- "Insert a condition statement, prompting for the condition name."
- "[condition]: "
- "when " str | -5 )
-
-
-(define-skeleton ada-accept-2
- "Insert an accept statement, prompting for the name and arguments."
- "[accept name]: "
- > "accept " str
- (ada-get-param)
- " do" \n
- > _ \n
- < "end " str ";" )
-
-
-(define-skeleton ada-accept
- "Insert an accept statement (prompt for condition, name and arguments)."
- ()
- > (ada-accept-1) & " =>\n"
- (ada-accept-2))
-
-
-(define-skeleton ada-or-accept
- "Insert an accept alternative, prompting for the condition name."
- ()
- < "or\n"
- (ada-accept))
-
-
-(define-skeleton ada-or-delay
- "Insert a delay alternative, prompting for the delay value."
- "[delay value]: "
- < "or\n"
- > "delay " str ";")
-
-
-(define-skeleton ada-or-terminate
- "Insert a terminate alternative."
- ()
- < "or\n"
- > "terminate;")
-
-
-(provide 'ada-stmt)
-
-;;; ada-stmt.el ends here
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
deleted file mode 100644
index c9c923e..0000000
--- a/lisp/progmodes/ada-xref.el
+++ /dev/null
@@ -1,2359 +0,0 @@
-;; ada-xref.el --- for lookup and completion in Ada mode
-
-;; Copyright (C) 1994-2019 Free Software Foundation, Inc.
-
-;; Author: Markus Heritsch <address@hidden>
-;; Rolf Ebert <address@hidden>
-;; Emmanuel Briot <address@hidden>
-;; Maintainer: Stephen Leake <address@hidden>
-;; Keywords: languages ada xref
-;; Package: ada-mode
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This Package provides a set of functions to use the output of the
-;; cross reference capabilities of the GNAT Ada compiler
-;; for lookup and completion in Ada mode.
-;;
-;; If a file *.`adp' exists in the ada-file directory, then it is
-;; read for configuration information. It is read only the first
-;; time a cross-reference is asked for, and is not read later.
-
-;;; Code:
-
-;; ----- Requirements -----------------------------------------------------
-
-(require 'compile)
-(require 'comint)
-(require 'find-file)
-(require 'ada-mode)
-(eval-when-compile (require 'cl-lib))
-
-;; ------ User variables
-(defcustom ada-xref-other-buffer t
- "If nil, always display the cross-references in the same buffer.
-Otherwise create either a new buffer or a new frame."
- :type 'boolean :group 'ada)
-
-(defcustom ada-xref-create-ali nil
- "If non-nil, run gcc whenever the cross-references are not up-to-date.
-If nil, the cross-reference mode never runs gcc."
- :type 'boolean :group 'ada)
-
-(defcustom ada-xref-confirm-compile nil
- "If non-nil, ask for confirmation before compiling or running the
application."
- :type 'boolean :group 'ada)
-
-(defcustom ada-krunch-args "0"
- "Maximum number of characters for filenames created by `gnatkr'.
-Set to 0, if you don't use crunched filenames. This should be a string."
- :type 'string :group 'ada)
-
-(defcustom ada-gnat-cmd "gnat"
- "Default GNAT project file parser.
-Will be run with args \"list -v -Pfile.gpr\".
-Default is standard GNAT distribution; alternate \"gnatpath\"
-is faster, available from Ada mode web site."
- :type 'string :group 'ada)
-
-(defcustom ada-gnatls-args '("-v")
- "Arguments to pass to `gnatls' to find location of the runtime.
-Typical use is to pass `--RTS=soft-floats' on some systems that support it.
-
-You can also add `-I-' if you do not want the current directory to be included.
-Otherwise, going from specs to bodies and back will first look for files in the
-current directory. This only has an impact if you are not using project files,
-but only ADA_INCLUDE_PATH."
- :type '(repeat string) :group 'ada)
-
-(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
- "Default compilation options."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-bind-opt ""
- "Default binder options."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-link-opt ""
- "Default linker options."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-gnatmake-opt "-g"
- "Default options for `gnatmake'."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-gpr-file ""
- "Default GNAT project file.
-If non-empty, this file is parsed to set the source and object directories for
-the Ada mode project."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-ada-project-path-sep
- (cond ((boundp 'path-separator) path-separator) ; 20.3+
- ((memq system-type '(windows-nt ms-dos)) ";")
- (t ":"))
- "Default separator for ada_project_path project variable."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-gnatfind-switches "-rf"
- "Default switches to use for `gnatfind'.
-You should modify this variable, for instance to add `-a', if you are working
-in an environment where most ALI files are write-protected.
-The command `gnatfind' is used every time you choose the menu
-\"Show all references\"."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-check-cmd
- (concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt}
${full_current}"
- " -cargs ${comp_opt}")
- "Default command to be used to compile a single file.
-Emacs will substitute the current filename for ${full_current}, or add
-the filename at the end. This is the same syntax as in the project file."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-comp-cmd
- (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current}
-cargs"
- " ${comp_opt}")
- "Default command to be used to compile a single file.
-Emacs will substitute the current filename for ${full_current}, or add
-the filename at the end. This is the same syntax as in the project file."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
- "Default name of the debugger."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-make-cmd
- (concat "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} "
- "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
- "Default command to be used to compile the application.
-This is the same syntax as in the project file."
- :type 'string :group 'ada)
-
-(defcustom ada-prj-default-project-file ""
- "Name of the current project file.
-Emacs will not try to use the search algorithm to find the project file if
-this string is not empty. It is set whenever a project file is found."
- :type '(file :must-match t) :group 'ada)
-
-(defcustom ada-gnatstub-opts "-q -I${src_dir}"
- "Options to pass to `gnatsub' to generate the body of a package.
-This has the same syntax as in the project file (with variable substitution)."
- :type 'string :group 'ada)
-
-(defcustom ada-always-ask-project nil
- "If nil, use default values when no project file was found.
-Otherwise, ask the user for the name of the project file to use."
- :type 'boolean :group 'ada)
-
-(defconst ada-on-ms-windows (memq system-type '(windows-nt))
- "True if we are running on Windows.")
-
-(defcustom ada-tight-gvd-integration nil
- "If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
-If GVD is not the debugger used, nothing happens."
- :type 'boolean :group 'ada)
-
-(defcustom ada-xref-search-with-egrep t
- "If non-nil, use grep -E to find the possible declarations for an entity.
-This alternate method is used when the exact location was not found in the
-information provided by GNAT. However, it might be expensive if you have a lot
-of sources, since it will search in all the files in your project."
- :type 'boolean :group 'ada)
-
-(defvar ada-load-project-hook nil
- "Hook that is run when loading a project file.
-Each function in this hook takes one argument FILENAME, that is the name of
-the project file to load.
-This hook should be used to support new formats for the project files.
-
-If the function can load the file with the given filename, it should create a
-buffer that contains a conversion of the file to the standard format of the
-project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\"
-lines.) It should return nil if it doesn't know how to convert that project
-file.")
-
-
-;; ------- Nothing to be modified by the user below this
-(defvar ada-last-prj-file ""
- "Name of the last project file entered by the user.")
-
-(defconst ada-prj-file-extension ".adp"
- "The extension used for project files.")
-
-(defvar ada-xref-runtime-library-specs-path '()
- "Directories where the specs for the standard library is found.
-This is used for cross-references.")
-
-(defvar ada-xref-runtime-library-ali-path '()
- "Directories where the ali for the standard library is found.
-This is used for cross-references.")
-
-(defvar ada-xref-pos-ring '()
- "List of positions selected by the cross-references functions.
-Used to go back to these positions.")
-
-(defvar ada-cd-command
- (if (string-match "cmdproxy.exe" shell-file-name)
- "cd /d"
- "cd")
- "Command to use to change to a specific directory.
-On Windows systems using `cmdproxy.exe' as the shell,
-we need to use `/d' or the drive is never changed.")
-
-(defvar ada-command-separator (if ada-on-ms-windows " && " "\n")
- "Separator to use between multiple commands to `compile' or `start-process'.
-`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use
-\"&&\" for now.")
-
-(defconst ada-xref-pos-ring-max 16
- "Number of positions kept in the list `ada-xref-pos-ring'.")
-
-(defvar ada-operator-re
-
"\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
- "Regexp to match for operators.")
-
-(defvar ada-xref-project-files '()
- "Associative list of project files with properties.
-It has the format: (project project ...)
-A project has the format: (project-file . project-plist)
-\(See `apropos plist' for operations on property lists).
-See `ada-default-prj-properties' for the list of valid properties.
-The current project is retrieved with `ada-xref-current-project'.
-Properties are retrieved with `ada-xref-get-project-field', set with
-`ada-xref-set-project-field'. If project properties are accessed with no
-project file, a (nil . default-properties) entry is created.")
-
-
-;; ----- Identlist manipulation -------------------------------------------
-;; An identlist is a vector that is used internally to reference an identifier
-;; To facilitate its use, we provide the following macros
-
-(defmacro ada-make-identlist () (make-vector 8 nil))
-(defmacro ada-name-of (identlist) (list 'aref identlist 0))
-(defmacro ada-line-of (identlist) (list 'aref identlist 1))
-(defmacro ada-column-of (identlist) (list 'aref identlist 2))
-(defmacro ada-file-of (identlist) (list 'aref identlist 3))
-(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4))
-(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5))
-(defmacro ada-references-of (identlist) (list 'aref identlist 6))
-(defmacro ada-on-declaration (identlist) (list 'aref identlist 7))
-
-(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name))
-(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line))
-(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col))
-(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file))
-(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index))
-(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file))
-(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref))
-(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
-
-(defsubst ada-get-ali-buffer (file)
- "Read the ali file FILE into a new buffer, and return the buffer's name."
- (find-file-noselect (ada-get-ali-file-name file)))
-
-
-;; -----------------------------------------------------------------------
-
-(defun ada-quote-cmd (cmd)
- "Duplicate all `\\' characters in CMD so that it can be passed to `compile'."
- (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
-
-(defun ada-find-executable (exec-name)
- "Find the full path to the executable file EXEC-NAME.
-If not found, throw an error.
-On Windows systems, this will properly handle .exe extension as well."
- (let ((result (or (ada-find-file-in-dir exec-name exec-path)
- (ada-find-file-in-dir (concat exec-name ".exe")
exec-path))))
- (if result
- result
- (error "`%s' not found in path" exec-name))))
-
-(defun ada-initialize-runtime-library (cross-prefix)
- "Initialize the variables for the runtime library location.
-CROSS-PREFIX is the prefix to use for the `gnatls' command."
- (let ((gnatls
- (condition-case nil
- ;; if gnatls not found, just give up (may not be using GNAT)
- (ada-find-executable (concat cross-prefix "gnatls"))
- (error nil))))
- (if gnatls
- (save-excursion
- (setq ada-xref-runtime-library-specs-path '()
- ada-xref-runtime-library-ali-path '())
- (set-buffer (get-buffer-create "*gnatls*"))
- (widen)
- (erase-buffer)
- ;; Even if we get an error, delete the *gnatls* buffer
- (unwind-protect
- (let ((status (apply 'call-process gnatls (append '(nil t nil)
ada-gnatls-args))))
- (goto-char (point-min))
-
- ;; Since we didn't provide all the inputs gnatls expects, it
returns status 4
- (if (/= 4 status)
- (error (buffer-substring (point) (line-end-position))))
-
- ;; Source path
-
- (search-forward "Source Search Path:")
- (forward-line 1)
- (while (not (looking-at "^$"))
- (back-to-indentation)
- (add-to-list 'ada-xref-runtime-library-specs-path
- (if (looking-at "<Current_Directory>")
- "."
- (buffer-substring-no-properties
- (point)
- (point-at-eol))))
- (forward-line 1))
-
- ;; Object path
-
- (search-forward "Object Search Path:")
- (forward-line 1)
- (while (not (looking-at "^$"))
- (back-to-indentation)
- (add-to-list 'ada-xref-runtime-library-ali-path
- (if (looking-at "<Current_Directory>")
- "."
- (buffer-substring-no-properties
- (point)
- (point-at-eol))))
- (forward-line 1))
- )
- (kill-buffer nil))))
-
- (setq ada-xref-runtime-library-specs-path
- (reverse ada-xref-runtime-library-specs-path))
- (setq ada-xref-runtime-library-ali-path
- (reverse ada-xref-runtime-library-ali-path))
- ))
-
-(defun ada-gnat-parse-gpr (plist gpr-file)
- "Set gpr_file, src_dir and obj_dir properties in PLIST by parsing GPR-FILE.
-Return new value of PLIST.
-GPR_FILE must be full path to file, normalized.
-src_dir, obj_dir will include compiler runtime.
-Assumes environment variable ADA_PROJECT_PATH is set properly."
- (with-current-buffer (get-buffer-create "*gnatls*")
- (erase-buffer)
-
- ;; this can take a long time; let the user know what's up
- (message "Parsing %s ..." gpr-file)
-
- ;; Even if we get an error, delete the *gnatls* buffer
- (unwind-protect
- (let* ((cross-prefix (plist-get plist 'cross_prefix))
- (gnat (concat cross-prefix ada-gnat-cmd))
- ;; Putting quotes around gpr-file confuses gnatpath on Lynx; not
clear why
- (gpr-opt (concat "-P" gpr-file))
- (src-dir '())
- (obj-dir '())
- (status (call-process gnat nil t nil "list" "-v" gpr-opt)))
- (goto-char (point-min))
-
- (if (/= 0 status)
- (error (buffer-substring (point) (line-end-position))))
-
- ;; Source path
-
- (search-forward "Source Search Path:")
- (forward-line 1) ; first directory in list
- (while (not (looking-at "^$")) ; terminate on blank line
- (back-to-indentation) ; skip whitespace
- (cl-pushnew (if (looking-at "<Current_Directory>")
- default-directory
- (expand-file-name
- (buffer-substring-no-properties
- (point) (line-end-position))))
- src-dir :test #'equal)
- (forward-line 1))
-
- ;; Object path
-
- (search-forward "Object Search Path:")
- (forward-line 1)
- (while (not (looking-at "^$"))
- (back-to-indentation)
- (cl-pushnew (if (looking-at "<Current_Directory>")
- default-directory
- (expand-file-name
- (buffer-substring-no-properties
- (point) (line-end-position))))
- obj-dir :test #'equal)
- (forward-line 1))
-
- ;; Set properties
- (setq plist (plist-put plist 'gpr_file gpr-file))
- (setq plist (plist-put plist 'src_dir src-dir))
- (plist-put plist 'obj_dir obj-dir)
- )
- (kill-buffer nil)
- (message "Parsing %s ... done" gpr-file)
- )
- ))
-
-(defun ada-treat-cmd-string (cmd-string)
- "Replace variable references ${var} in CMD-STRING with the appropriate value.
-Also replace standard environment variables $var.
-Assumes project exists.
-As a special case, ${current} is replaced with the name of the current
-file, minus extension but with directory, and ${full_current} is
-replaced by the name including the extension."
-
- (while (string-match "\\(-[^-$IO]*[IO]\\)?\\${\\([^}]+\\)}" cmd-string)
- (let (value
- (name (match-string 2 cmd-string)))
- (cond
- ((string= name "current")
- (setq value (file-name-sans-extension (buffer-file-name))))
- ((string= name "full_current")
- (setq value (buffer-file-name)))
- (t
- (save-match-data
- (setq value (ada-xref-get-project-field (intern name))))))
-
- ;; Check if there is an environment variable with the same name
- (if (null value)
- (if (not (setq value (getenv name)))
- (message "%s" (concat "No project or environment variable " name
" found"))))
-
- (cond
- ((null value)
- (setq cmd-string (replace-match "" t t cmd-string)))
- ((stringp value)
- (setq cmd-string (replace-match value t t cmd-string)))
- ((listp value)
- (let ((prefix (match-string 1 cmd-string)))
- (setq cmd-string (replace-match
- (mapconcat (lambda(x) (concat prefix x)) value " ")
- t t cmd-string)))))
- ))
- (substitute-in-file-name cmd-string))
-
-
-(defun ada-xref-get-project-field (field)
- "Extract the value of FIELD from the current project file.
-Project variables are substituted.
-
-Note that for src_dir and obj_dir, you should rather use
-`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field'
-which will in addition return the default paths."
-
- (let* ((project-plist (cdr (ada-xref-current-project)))
- (value (plist-get project-plist field)))
-
- (cond
- ((eq field 'gnatmake_opt)
- (let ((gpr-file (plist-get project-plist 'gpr_file)))
- (if (not (string= gpr-file ""))
- (setq value (concat "-P\"" gpr-file "\" " value)))))
-
- ;; FIXME: check for src_dir, obj_dir here, rather than requiring user to
do it
- (t
- nil))
-
- ;; Substitute the ${...} constructs in all the strings, including
- ;; inside lists
- (cond
- ((stringp value)
- (ada-treat-cmd-string value))
- ((null value)
- nil)
- ((listp value)
- (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value))
- (t
- value)
- )
- ))
-
-(defun ada-xref-get-src-dir-field ()
- "Return the full value for src_dir, including the default directories.
-All the directories are returned as absolute directories."
-
- (let ((build-dir (ada-xref-get-project-field 'build_dir)))
- (append
- ;; Add ${build_dir} in front of the path
- (list build-dir)
-
- (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)
- build-dir)
-
- ;; Add the standard runtime at the end
- ada-xref-runtime-library-specs-path)))
-
-(defun ada-xref-get-obj-dir-field ()
- "Return the full value for obj_dir, including the default directories.
-All the directories are returned as absolute directories."
-
- (let ((build-dir (ada-xref-get-project-field 'build_dir)))
- (append
- ;; Add ${build_dir} in front of the path
- (list build-dir)
-
- (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir)
- build-dir)
-
- ;; Add the standard runtime at the end
- ada-xref-runtime-library-ali-path)))
-
-(defun ada-xref-set-project-field (field value)
- "Set FIELD to VALUE in current project. Assumes project exists."
- ;; same algorithm to find project-plist as ada-xref-current-project
- (let* ((file-name (ada-xref-current-project-file))
- (project-plist (cdr (assoc file-name ada-xref-project-files))))
-
- (setq project-plist (plist-put project-plist field value))
- (setcdr (assoc file-name ada-xref-project-files) project-plist)))
-
-(defun ada-xref-update-project-menu ()
- "Update the menu Ada->Project, with the list of available project files."
- ;; Create the standard items.
- (let ((submenu
- `("Project"
- ["Load..." ada-set-default-project-file t]
- ["New..." ada-prj-new t]
- ["Edit..." ada-prj-edit t]
- "---"
- ;; Add the project files
- ,@(mapcar
- (lambda (x)
- (let* ((name (or (car x) "<default>"))
- (command `(lambda ()
- "Select the current project file."
- (interactive)
- (ada-select-prj-file ,name))))
- (vector
- (file-name-nondirectory name)
- command
- :button (cons
- :toggle
- (equal ada-prj-default-project-file
- (car x))
- ))))
-
- (or ada-xref-project-files '(nil))))))
-
- (easy-menu-add-item ada-mode-menu '() submenu)))
-
-
-;;-------------------------------------------------------------
-;;-- Searching a file anywhere on the source path.
-;;--
-;;-- The following functions provide support for finding a file anywhere
-;;-- on the source path, without providing an explicit directory.
-;;-- They also provide file name completion in the minibuffer.
-;;--
-;;-- Public subprograms: ada-find-file
-;;--
-;;-------------------------------------------------------------
-
-(defun ada-do-file-completion (string predicate flag)
- "Completion function when reading a file from the minibuffer.
-Completion is attempted in all the directories in the source path,
-as defined in the project file."
- ;; FIXME: doc arguments
-
- ;; This function is not itself interactive, but it is called as part
- ;; of the prompt of interactive functions, so we require a project
- ;; file.
- (ada-require-project-file)
- (let (list
- (dirs (ada-xref-get-src-dir-field)))
-
- (while dirs
- (if (file-directory-p (car dirs))
- (setq list (append list (file-name-all-completions string (car
dirs)))))
- (setq dirs (cdr dirs)))
- (cond ((equal flag 'lambda)
- (assoc string list))
- (flag
- list)
- (t
- (try-completion string
- (mapcar (lambda (x) (cons x 1)) list)
- predicate)))))
-
-;;;###autoload
-(defun ada-find-file (filename)
- "Open FILENAME, from anywhere in the source path.
-Completion is available."
- (interactive
- (list (completing-read "File: " 'ada-do-file-completion)))
- (let ((file (ada-find-src-file-in-dir filename)))
- (if file
- (find-file file)
- (error "%s not found in src_dir" filename))))
-
-
-;; ----- Utilities -------------------------------------------------
-
-(defun ada-require-project-file ()
- "If the current project does not exist, load or create a default one.
-Should only be called from interactive functions."
- (if (string= "" ada-prj-default-project-file)
- (ada-reread-prj-file (ada-prj-find-prj-file t))))
-
-(defun ada-xref-current-project-file ()
- "Return the current project file name; never nil.
-Call `ada-require-project-file' first if a project must exist."
- (if (not (string= "" ada-prj-default-project-file))
- ada-prj-default-project-file
- (ada-prj-find-prj-file t)))
-
-(defun ada-xref-current-project ()
- "Return the current project.
-Call `ada-require-project-file' first to ensure a project exists."
- (let ((file-name (ada-xref-current-project-file)))
- (assoc file-name ada-xref-project-files)))
-
-(defun ada-show-current-project ()
- "Display current project file name in message buffer."
- (interactive)
- (message (ada-xref-current-project-file)))
-
-(defun ada-show-current-main ()
- "Display current main file name in message buffer."
- (interactive)
- (message "ada-mode main: %s" (ada-xref-get-project-field 'main)))
-
-(defun ada-xref-push-pos (filename position)
- "Push (FILENAME, POSITION) on the position ring for cross-references."
- (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring))
- (if (> (length ada-xref-pos-ring) ada-xref-pos-ring-max)
- (setcdr (nthcdr (1- ada-xref-pos-ring-max) ada-xref-pos-ring) nil)))
-
-(defun ada-xref-goto-previous-reference ()
- "Go to the previous cross-reference we were on."
- (interactive)
- (if ada-xref-pos-ring
- (let ((pos (car ada-xref-pos-ring)))
- (setq ada-xref-pos-ring (cdr ada-xref-pos-ring))
- (find-file (car (cdr pos)))
- (goto-char (car pos)))))
-
-(defun ada-set-default-project-file (file)
- "Set FILE as the current project file."
- (interactive "fProject file:")
- (ada-parse-prj-file file)
- (ada-select-prj-file file))
-
-;; ------ Handling the project file -----------------------------
-
-(defun ada-prj-find-prj-file (&optional no-user-question)
- "Find the project file associated with the current buffer.
-If the buffer is not in Ada mode, or not associated with a file,
-return `ada-prj-default-project-file'. Otherwise, search for a file with
-the same base name as the Ada file, but extension given by
-`ada-prj-file-extension' (default .adp). If not found, search for *.adp
-in the current directory; if several are found, and NO-USER-QUESTION
-is non-nil, prompt the user to select one. If none are found, return
-\"default.adp\"."
-
- (let (selected)
-
- (if (not (and (derived-mode-p 'ada-mode)
- buffer-file-name))
-
- ;; Not in an Ada buffer, or current buffer not associated
- ;; with a file (for instance an emerge buffer)
- (setq selected nil)
-
- ;; other cases: use a more complex algorithm
-
- (let* ((current-file (buffer-file-name))
- (first-choice (concat
- (file-name-sans-extension current-file)
- ada-prj-file-extension))
- (dir (file-name-directory current-file))
-
- (prj-files (directory-files
- dir t
- (concat ".*" (regexp-quote
- ada-prj-file-extension) "$")))
- (choice nil))
-
- (cond
-
- ((file-exists-p first-choice)
- ;; filename.adp
- (setq selected first-choice))
-
- ((= (length prj-files) 1)
- ;; Exactly one project file was found in the current directory
- (setq selected (car prj-files)))
-
- ((and (> (length prj-files) 1) (not no-user-question))
- ;; multiple project files in current directory, ask the user
- (save-window-excursion
- (with-output-to-temp-buffer "*choice list*"
- (princ "There are more than one possible project file.\n")
- (princ "Which one should we use ?\n\n")
- (princ " no. file name \n")
- (princ " --- ------------------------\n")
- (let ((counter 1))
- (while (<= counter (length prj-files))
- (princ (format " %2d) %s\n"
- counter
- (nth (1- counter) prj-files)))
- (setq counter (1+ counter))
-
- ))) ; end of with-output-to ...
- (setq choice nil)
- (while (or
- (not choice)
- (not (integerp choice))
- (< choice 1)
- (> choice (length prj-files)))
- (setq choice (string-to-number
- (read-from-minibuffer "Enter No. of your choice:
"))))
- (setq selected (nth (1- choice) prj-files))))
-
- ((= (length prj-files) 0)
- ;; No project file in the current directory; ask user
- (unless (or no-user-question (not ada-always-ask-project))
- (setq ada-last-prj-file
- (read-file-name
- (concat "project file [" ada-last-prj-file "]:")
- nil ada-last-prj-file))
- (unless (string= ada-last-prj-file "")
- (setq selected ada-last-prj-file))))
- )))
-
- (or selected "default.adp")
- ))
-
-(defun ada-default-prj-properties ()
- "Return the default project properties list with the current buffer as main."
-
- (let ((file (buffer-file-name nil)))
- (list
- ;; variable name alphabetical order
- 'ada_project_path (or (getenv "ADA_PROJECT_PATH") "")
- 'ada_project_path_sep ada-prj-ada-project-path-sep
- 'bind_opt ada-prj-default-bind-opt
- 'build_dir default-directory
- 'casing (if (listp ada-case-exception-file)
- ada-case-exception-file
- (list ada-case-exception-file))
- 'check_cmd (list ada-prj-default-check-cmd) ;; FIXME: should not a
list
- 'comp_cmd (list ada-prj-default-comp-cmd) ;; FIXME: should not a
list
- 'comp_opt ada-prj-default-comp-opt
- 'cross_prefix ""
- 'debug_cmd (concat ada-prj-default-debugger
- " ${main}" (if ada-on-ms-windows ".exe")) ;;
FIXME: don't need .exe?
- 'debug_post_cmd (list nil)
- 'debug_pre_cmd (list (concat ada-cd-command " ${build_dir}"))
- 'gnatmake_opt ada-prj-default-gnatmake-opt
- 'gnatfind_opt ada-prj-gnatfind-switches
- 'gpr_file ada-prj-default-gpr-file
- 'link_opt ada-prj-default-link-opt
- 'main (if file
- (file-name-nondirectory
- (file-name-sans-extension file))
- "")
- 'make_cmd (list ada-prj-default-make-cmd) ;; FIXME: should not a
list
- 'obj_dir (list ".")
- 'remote_machine ""
- 'run_cmd (list (concat "./${main}" (if ada-on-ms-windows ".exe")))
- ;; FIXME: should not a list
- ;; FIXME: don't need .exe?
- 'src_dir (list ".")
- )))
-
-(defun ada-parse-prj-file (prj-file)
- "Read PRJ-FILE, set project properties in `ada-xref-project-files'."
- (let ((project (ada-default-prj-properties)))
-
- (setq prj-file (expand-file-name prj-file))
- (if (string= (file-name-extension prj-file) "gpr")
- (setq project (ada-gnat-parse-gpr project prj-file))
-
- (setq project (ada-parse-prj-file-1 prj-file project))
- )
-
- ;; Store the project properties
- (if (assoc prj-file ada-xref-project-files)
- (setcdr (assoc prj-file ada-xref-project-files) project)
- (add-to-list 'ada-xref-project-files (cons prj-file project)))
-
- (ada-xref-update-project-menu)
- ))
-
-(defun ada-parse-prj-file-1 (prj-file project)
- "Parse the Ada mode project file PRJ-FILE, set project properties in PROJECT.
-Return new value of PROJECT."
- (let ((ada-buffer (current-buffer))
- ;; fields that are lists or otherwise require special processing
- ada_project_path casing comp_cmd check_cmd
- debug_pre_cmd debug_post_cmd gpr_file make_cmd obj_dir src_dir run_cmd)
-
- ;; Give users a chance to use compiler-specific project file formats
- (let ((buffer (run-hook-with-args-until-success
- 'ada-load-project-hook prj-file)))
- (unless buffer
- ;; we load the project file with no warnings; if it does not
- ;; exist, we stay in the Ada buffer; no project variable
- ;; settings will be found. That works for the default
- ;; "default.adp", which does not exist as a file.
- (setq buffer (find-file-noselect prj-file nil)))
- (set-buffer buffer))
-
- (widen)
- (goto-char (point-min))
-
- ;; process each line
- (while (not (eobp))
-
- ;; ignore lines that don't have the format "name=value", put
- ;; 'name', 'value' in match-string.
- (if (looking-at "^\\([^=\n]+\\)=\\(.*\\)")
- (cond
- ;; FIXME: strip trailing spaces
- ;; variable name alphabetical order
- ((string= (match-string 1) "ada_project_path")
- (cl-pushnew (expand-file-name
- (substitute-in-file-name (match-string 2)))
- ada_project_path :test #'equal))
-
- ((string= (match-string 1) "build_dir")
- (setq project
- (plist-put project 'build_dir
- (file-name-as-directory (match-string 2)))))
-
- ((string= (match-string 1) "casing")
- (cl-pushnew (expand-file-name (substitute-in-file-name
(match-string 2)))
- casing :test #'equal))
-
- ((string= (match-string 1) "check_cmd")
- (cl-pushnew (match-string 2) check_cmd :test #'equal))
-
- ((string= (match-string 1) "comp_cmd")
- (cl-pushnew (match-string 2) comp_cmd :test #'equal))
-
- ((string= (match-string 1) "debug_post_cmd")
- (cl-pushnew (match-string 2) debug_post_cmd :test #'equal))
-
- ((string= (match-string 1) "debug_pre_cmd")
- (cl-pushnew (match-string 2) debug_pre_cmd :test #'equal))
-
- ((string= (match-string 1) "gpr_file")
- ;; expand now; path is relative to Emacs project file
- (setq gpr_file (expand-file-name (match-string 2))))
-
- ((string= (match-string 1) "make_cmd")
- (cl-pushnew (match-string 2) make_cmd :test #'equal))
-
- ((string= (match-string 1) "obj_dir")
- (cl-pushnew (file-name-as-directory
- (expand-file-name (match-string 2)))
- obj_dir :test #'equal))
-
- ((string= (match-string 1) "run_cmd")
- (cl-pushnew (match-string 2) run_cmd :test #'equal))
-
- ((string= (match-string 1) "src_dir")
- (cl-pushnew (file-name-as-directory
- (expand-file-name (match-string 2)))
- src_dir :test #'equal))
-
- (t
- ;; any other field in the file is just copied
- (setq project (plist-put project
- (intern (match-string 1))
- (match-string 2))))))
-
- (forward-line 1))
-
- ;; done reading file
-
- ;; back to the user buffer
- (set-buffer ada-buffer)
-
- ;; process accumulated lists
- (if ada_project_path
- (let ((sep (plist-get project 'ada_project_path_sep)))
- (setq ada_project_path (reverse ada_project_path))
- (setq ada_project_path (mapconcat 'identity ada_project_path sep))
- (setq project (plist-put project 'ada_project_path ada_project_path))
- ;; env var needed now for ada-gnat-parse-gpr
- (setenv "ADA_PROJECT_PATH" ada_project_path)))
-
- (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd
(reverse debug_post_cmd))))
- (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse
debug_pre_cmd))))
- (if casing (setq project (plist-put project 'casing (reverse casing))))
- (if check_cmd (setq project (plist-put project 'check_cmd (reverse
check_cmd))))
- (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse
comp_cmd))))
- (if make_cmd (setq project (plist-put project 'make_cmd (reverse
make_cmd))))
- (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd))))
-
- (if gpr_file
- (progn
- (setq project (ada-gnat-parse-gpr project gpr_file))
- ;; append Ada source and object directories to others from Emacs
project file
- (setq src_dir (append (plist-get project 'src_dir) src_dir))
- (setq obj_dir (append (plist-get project 'obj_dir) obj_dir))
- (setq ada-xref-runtime-library-specs-path '()
- ada-xref-runtime-library-ali-path '()))
- )
-
- ;; FIXME: gnatpath.exe doesn't output the runtime libraries, so always
call ada-initialize-runtime-library
- ;; if using a gpr_file, the runtime library directories are
- ;; included in src_dir and obj_dir; otherwise they are in the
- ;; 'runtime-library' variables.
- ;; FIXME: always append to src_dir, obj_dir
- (ada-initialize-runtime-library (or (ada-xref-get-project-field
'cross_prefix) ""))
- ;;)
-
- (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir))))
- (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
-
- project
- ))
-
-(defun ada-select-prj-file (file)
- "Select FILE as the current project file."
- (interactive)
- (setq ada-prj-default-project-file (expand-file-name file))
-
- (let ((casing (ada-xref-get-project-field 'casing)))
- (if casing
- (progn
- ;; FIXME: use ada-get-absolute-dir here
- (setq ada-case-exception-file casing)
- (ada-case-read-exceptions))))
-
- (let ((ada_project_path (ada-xref-get-project-field 'ada_project_path)))
- (if ada_project_path
- ;; FIXME: use ada-get-absolute-dir, mapconcat here
- (setenv "ADA_PROJECT_PATH" ada_project_path)))
-
- (setq compilation-search-path (ada-xref-get-src-dir-field))
-
- (setq ada-search-directories-internal
- ;; FIXME: why do we need directory-file-name here?
- (append (mapcar 'directory-file-name compilation-search-path)
- ada-search-directories))
-
- ;; return t, for decent display in message buffer when called interactively
- t)
-
-(defun ada-find-references (&optional pos arg local-only)
- "Find all references to the entity under POS.
-Calls gnatfind to find the references.
-If ARG is non-nil, the contents of the old *gnatfind* buffer is preserved.
-If LOCAL-ONLY is non-nil, only declarations in the current file are returned."
- (interactive "d\nP")
- (ada-require-project-file)
-
- (let* ((identlist (ada-read-identifier pos))
- (alifile (ada-get-ali-file-name (ada-file-of identlist)))
- (process-environment (ada-set-environment)))
-
- (set-buffer (get-file-buffer (ada-file-of identlist)))
-
- ;; if the file is more recent than the executable
- (if (or (buffer-modified-p (current-buffer))
- (file-newer-than-file-p (ada-file-of identlist) alifile))
- (ada-find-any-references (ada-name-of identlist)
- (ada-file-of identlist)
- nil nil local-only arg)
- (ada-find-any-references (ada-name-of identlist)
- (ada-file-of identlist)
- (ada-line-of identlist)
- (ada-column-of identlist) local-only arg)))
- )
-
-(defun ada-find-local-references (&optional pos arg)
- "Find all references to the entity under POS.
-Calls `gnatfind' to find the references.
-If ARG is non-nil, the contents of the old *gnatfind* buffer is preserved."
- (interactive "d\nP")
- (ada-find-references pos arg t))
-
-(defconst ada-gnatfind-buffer-name "*gnatfind*")
-
-(defun ada-find-any-references
- (entity &optional file line column local-only append)
- "Search for references to any entity whose name is ENTITY.
-ENTITY was first found the location given by FILE, LINE and COLUMN.
-If LOCAL-ONLY is non-nil, then list only the references in FILE,
-which is much faster.
-If APPEND is non-nil, then append the output of the command to the
-existing buffer `*gnatfind*', if there is one."
- (interactive "sEntity name: ")
- (ada-require-project-file)
-
- ;; Prepare the gnatfind command. Note that we must protect the quotes
- ;; around operators, so that they are correctly handled and can be
- ;; processed (gnatfind \"+\":...).
- (let* ((quote-entity
- (if (= (aref entity 0) ?\")
- (if ada-on-ms-windows
- (concat "\\\"" (substring entity 1 -1) "\\\"")
- (concat "'\"" (substring entity 1 -1) "\"'"))
- entity))
- (switches (ada-xref-get-project-field 'gnatfind_opt))
- ;; FIXME: use gpr_file
- (cross-prefix (ada-xref-get-project-field 'cross_prefix))
- (command (concat cross-prefix "gnat find " switches " "
- quote-entity
- (if file (concat ":" (file-name-nondirectory file)))
- (if line (concat ":" line))
- (if column (concat ":" column))
- (if local-only (concat " " (file-name-nondirectory
file)))
- ))
- old-contents)
-
- ;; If a project file is defined, use it
- (if (and ada-prj-default-project-file
- (not (string= ada-prj-default-project-file "")))
- (if (string-equal (file-name-extension ada-prj-default-project-file)
- "gpr")
- (setq command (concat command " -P\"" ada-prj-default-project-file
"\""))
- (setq command (concat command " -p\"" ada-prj-default-project-file
"\""))))
-
- (if (and append (get-buffer ada-gnatfind-buffer-name))
- (with-current-buffer "*gnatfind*"
- (setq old-contents (buffer-string))))
-
- (let ((compilation-error "reference"))
- (compilation-start command 'compilation-mode (lambda (_mode)
ada-gnatfind-buffer-name)))
-
- ;; Hide the "Compilation" menu
- (with-current-buffer ada-gnatfind-buffer-name
- (local-unset-key [menu-bar compilation-menu])
-
- (if old-contents
- (progn
- (goto-char 1)
- (setq buffer-read-only nil)
- (insert old-contents)
- (setq buffer-read-only t)
- (goto-char (point-max)))))
- )
- )
-
-(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
-
-;; ----- Identifier Completion --------------------------------------------
-(defun ada-complete-identifier (pos)
- "Try to complete the identifier around POS, using compiler cross-reference
information."
- (interactive "d")
- (ada-require-project-file)
-
- ;; Initialize function-local variables and jump to the .ali buffer
- ;; Note that for regexp search is case insensitive too
- (let* ((curbuf (current-buffer))
- (identlist (ada-read-identifier pos))
- (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\("
- (regexp-quote (ada-name-of identlist))
- "[a-zA-Z0-9_]*\\)"))
- (completed nil)
- (symalist nil))
-
- ;; Open the .ali file
- (set-buffer (ada-get-ali-buffer (buffer-file-name)))
- (goto-char (point-max))
-
- ;; build an alist of possible completions
- (while (re-search-backward sofar nil t)
- (setq symalist (cons (cons (match-string 1) nil) symalist)))
-
- (setq completed (try-completion "" symalist))
-
- ;; kills .ali buffer
- (kill-buffer nil)
-
- ;; deletes the incomplete identifier in the buffer
- (set-buffer curbuf)
- (looking-at "[a-zA-Z0-9_]+")
- (replace-match "")
- ;; inserts the completed symbol
- (insert completed)
- ))
-
-;; ----- Cross-referencing ----------------------------------------
-
-(defun ada-point-and-xref ()
- "Jump to the declaration of the entity below the cursor."
- (interactive)
- (mouse-set-point last-input-event)
- (ada-goto-declaration (point)))
-
-(defun ada-point-and-xref-body ()
- "Jump to the body of the entity under the cursor."
- (interactive)
- (mouse-set-point last-input-event)
- (ada-goto-body (point)))
-
-(defun ada-goto-body (pos &optional other-frame)
- "Display the body of the entity around POS.
-OTHER-FRAME non-nil means display in another frame.
-If the entity doesn't have a body, display its declaration.
-As a side effect, the buffer for the declaration is also open."
- (interactive "d")
- (ada-goto-declaration pos other-frame)
-
- ;; Temporarily force the display in the same buffer, since we
- ;; already changed previously
- (let ((ada-xref-other-buffer nil))
- (ada-goto-declaration (point) nil)))
-
-(defun ada-goto-declaration (pos &optional other-frame)
- "Display the declaration of the identifier around POS.
-The declaration is shown in another buffer if `ada-xref-other-buffer' is
-non-nil.
-If OTHER-FRAME is non-nil, display the cross-reference in another frame."
- (interactive "d")
- (ada-require-project-file)
- (push-mark pos)
- (ada-xref-push-pos (buffer-file-name) pos)
-
- ;; First try the standard algorithm by looking into the .ali file, but if
- ;; that file was too old or even did not exist, try to look in the whole
- ;; object path for a possible location.
- (let ((identlist (ada-read-identifier pos)))
- (condition-case err
- (ada-find-in-ali identlist other-frame)
- ;; File not found: print explicit error message
- (ada-error-file-not-found
- (message "%s%s" (error-message-string err) (nthcdr 1 err)))
-
- (error
- (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist))))
-
- ;; If the ALI file was up-to-date, then we probably have a predefined
- ;; entity, whose references are not given by GNAT
- (if (and (file-exists-p ali-file)
- (file-newer-than-file-p ali-file (ada-file-of identlist)))
- (message "No cross-reference found -- may be a predefined entity.")
-
- ;; Else, look in every ALI file, except if the user doesn't want that
- (if ada-xref-search-with-egrep
- (ada-find-in-src-path identlist other-frame)
- (message "Cross-referencing information is not up-to-date; please
recompile.")
- )))))))
-
-(defun ada-goto-declaration-other-frame (pos)
- "Display the declaration of the identifier around POS.
-The declaration is shown in another frame if `ada-xref-other-buffer' is
-non-nil."
- (interactive "d")
- (ada-goto-declaration pos t))
-
-(defun ada-remote (command)
- "Return the remote version of COMMAND, or COMMAND if remote_machine is nil."
- (let ((machine (ada-xref-get-project-field 'remote_machine)))
- (if (or (not machine) (string= machine ""))
- command
- (format "%s %s '(%s)'"
- remote-shell-program
- machine
- command))))
-
-(defun ada-get-absolute-dir-list (dir-list root-dir)
- "Return the list of absolute directories found in DIR-LIST.
-If a directory is a relative directory, ROOT-DIR is prepended.
-Project and environment variables are substituted."
- (mapcar (lambda (x) (expand-file-name x (ada-treat-cmd-string root-dir)))
dir-list))
-
-(defun ada-set-environment ()
- "Prepare an environment for Ada compilation.
-This returns a new value to use for `process-environment',
-but does not actually put it into use.
-It modifies the source path and object path with the values found in the
-project file."
- (let ((include (getenv "ADA_INCLUDE_PATH"))
- (objects (getenv "ADA_OBJECTS_PATH"))
- (build-dir (ada-xref-get-project-field 'build_dir)))
- (if include
- (setq include (concat path-separator include)))
- (if objects
- (setq objects (concat path-separator objects)))
- (cons
- (concat "ADA_INCLUDE_PATH="
- (mapconcat (lambda(x) (expand-file-name x build-dir))
- (ada-xref-get-project-field 'src_dir)
- path-separator)
- include)
- (cons
- (concat "ADA_OBJECTS_PATH="
- (mapconcat (lambda(x) (expand-file-name x build-dir))
- (ada-xref-get-project-field 'obj_dir)
- path-separator)
- objects)
- process-environment))))
-
-(defun ada-compile-application (&optional arg)
- "Compile the application, using the command found in the project file.
-If ARG is not nil, ask for user confirmation."
- (interactive "P")
- (ada-require-project-file)
- (let ((cmd (ada-xref-get-project-field 'make_cmd))
- (process-environment (ada-set-environment))
- (compilation-scroll-output t))
-
- (setq compilation-search-path (ada-xref-get-src-dir-field))
-
- ;; If no project file was found, ask the user
- (unless cmd
- (setq cmd '("") arg t))
-
- ;; Make a single command from the list of commands, including the
- ;; commands to run it on a remote machine.
- (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
-
- (if (or ada-xref-confirm-compile arg)
- (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
-
- ;; Insert newlines so as to separate the name of the commands to run
- ;; and the output of the commands. This doesn't work with cmdproxy.exe,
- ;; which gets confused by newline characters.
- (if (not (string-match ".exe" shell-file-name))
- (setq cmd (concat cmd "\n\n")))
-
- (compile (ada-quote-cmd cmd))))
-
-(defun ada-set-main-compile-application ()
- "Set main project variable to current buffer, build main."
- (interactive)
- (ada-require-project-file)
- (let* ((file (buffer-file-name (current-buffer)))
- main)
- (if (not file)
- (error "No file for current buffer")
-
- (setq main
- (if file
- (file-name-nondirectory
- (file-name-sans-extension file))
- ""))
- (ada-xref-set-project-field 'main main)
- (ada-compile-application))))
-
-(defun ada-compile-current (&optional arg prj-field)
- "Recompile the current file.
-If ARG is non-nil, ask for user confirmation of the command.
-PRJ-FIELD is the name of the field to use in the project file to get the
-command, and should be either `comp_cmd' (default) or `check_cmd'."
- (interactive "P")
- (ada-require-project-file)
- (let* ((field (if prj-field prj-field 'comp_cmd))
- (cmd (ada-xref-get-project-field field))
- (process-environment (ada-set-environment))
- (compilation-scroll-output t))
-
- (unless cmd
- (setq cmd '("") arg t))
-
- ;; Make a single command from the list of commands, including the
- ;; commands to run it on a remote machine.
- (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
-
- ;; If no project file was found, ask the user
- (if (or ada-xref-confirm-compile arg)
- (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
-
- (compile (ada-quote-cmd cmd))))
-
-(defun ada-check-current (&optional arg)
- "Check the current file for syntax errors.
-If ARG is non-nil, ask for user confirmation of the command."
- (interactive "P")
- (ada-compile-current arg 'check_cmd))
-
-(defun ada-run-application (&optional arg)
- "Run the application.
-If ARG is non-nil, ask for user confirmation."
- (interactive)
- (ada-require-project-file)
-
- (let ((machine (ada-xref-get-project-field 'cross_prefix)))
- (if (and machine (not (string= machine "")))
- (error "This feature is not supported yet for cross environments")))
-
- (let ((command (ada-xref-get-project-field 'run_cmd)))
-
- ;; Guess the command if it wasn't specified
- (if (not command)
- (setq command (list (file-name-sans-extension (buffer-name)))))
-
- ;; Modify the command to run remotely
- (setq command (ada-remote (mapconcat 'identity command
- ada-command-separator)))
-
- ;; Ask for the arguments to the command if required
- (if (or ada-xref-confirm-compile arg)
- (setq command (read-from-minibuffer "Enter command to execute: "
- command)))
-
- ;; Run the command
- (with-current-buffer (get-buffer-create "*run*")
- (setq buffer-read-only nil)
-
- (erase-buffer)
- (start-process "run" (current-buffer) shell-file-name
- "-c" command)
- (comint-mode)
- ;; Set these two variables to their default values, since otherwise
- ;; the output buffer is scrolled so that only the last output line
- ;; is visible at the top of the buffer.
- (set (make-local-variable 'scroll-step) 0)
- (set (make-local-variable 'scroll-conservatively) 0)
- )
- (display-buffer "*run*")
-
- ;; change to buffer *run* for interactive programs
- (other-window 1)
- (switch-to-buffer "*run*")
- ))
-
-(defun ada-gdb-application (&optional arg executable-name)
- "Start the debugger on the application.
-If ARG is non-nil, ask the user to confirm the command.
-EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the
-project file."
- (interactive "P")
- (ada-require-project-file)
- (let ((buffer (current-buffer))
- cmd pre-cmd post-cmd)
- (setq cmd (if executable-name
- (concat ada-prj-default-debugger " " executable-name)
- (ada-xref-get-project-field 'debug_cmd))
- pre-cmd (ada-xref-get-project-field 'debug_pre_cmd)
- post-cmd (ada-xref-get-project-field 'debug_post_cmd))
-
- ;; If the command was not given in the project file, start a bare gdb
- (if (not cmd)
- (setq cmd (concat ada-prj-default-debugger
- " "
- (or executable-name
- (file-name-sans-extension (buffer-file-name))))))
-
- ;; For gvd, add an extra switch so that the Emacs window is completely
- ;; swallowed inside the Gvd one
- (if (and ada-tight-gvd-integration
- (string-match "^[^ \t]*gvd" cmd))
- ;; Start a new frame, so that when gvd exists we do not kill Emacs
- ;; We make sure that gvd swallows the new frame, not the one the
- ;; user has been using until now
- ;; The frame is made invisible initially, so that GtkPlug gets a
- ;; chance to fully manage it. Then it works fine with Enlightenment
- ;; as well
- (let ((frame (make-frame '((visibility . nil)))))
- (setq cmd (concat
- cmd " --editor-window="
- (cdr (assoc 'outer-window-id (frame-parameters frame)))))
- (select-frame frame)))
-
- ;; Add a -fullname switch
- ;; Use the remote machine
- (setq cmd (ada-remote (concat cmd " -fullname ")))
-
- ;; Ask for confirmation if required
- (if (or arg ada-xref-confirm-compile)
- (setq cmd (read-from-minibuffer "enter command to debug: " cmd)))
-
- (let ((old-comint-exec (symbol-function 'comint-exec)))
-
- ;; Do not add -fullname, since we can have a 'rsh' command in front.
- ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef
- (fset 'gud-gdb-massage-args (lambda (_file args) args))
-
- (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
- (if (not (equal pre-cmd ""))
- (setq pre-cmd (concat pre-cmd ada-command-separator)))
-
- (setq post-cmd (mapconcat 'identity post-cmd "\n"))
- (if post-cmd
- (setq post-cmd (concat post-cmd "\n")))
-
-
- ;; Temporarily replaces the definition of `comint-exec' so that we
- ;; can execute commands before running gdb.
- ;; FIXME: This is evil and not temporary !!! -stef
- (fset 'comint-exec
- `(lambda (buffer name command startfile switches)
- (let (compilation-buffer-name-function)
- (save-excursion
- (setq compilation-buffer-name-function
- (lambda(x) (buffer-name buffer)))
- (compile (ada-quote-cmd
- (concat ,pre-cmd
- command " "
- (mapconcat 'identity switches " "))))))
- ))
-
- ;; Tight integration should force the tty mode
- (if (and (string-match "gvd" (comint-arguments cmd 0 0))
- ada-tight-gvd-integration
- (not (string-match "--tty" cmd)))
- (setq cmd (concat cmd "--tty")))
-
- (if (and (string-match "jdb" (comint-arguments cmd 0 0))
- (boundp 'jdb))
- (funcall (symbol-function 'jdb) cmd)
- (gdb cmd))
-
- ;; Restore the standard fset command (or for instance C-U M-x shell
- ;; wouldn't work anymore
-
- (fset 'comint-exec old-comint-exec)
-
- ;; Send post-commands to the debugger
- (process-send-string (get-buffer-process (current-buffer)) post-cmd)
-
- ;; Move to the end of the debugger buffer, so that it is automatically
- ;; scrolled from then on.
- (goto-char (point-max))
-
- ;; Display both the source window and the debugger window (the former
- ;; above the latter). No need to show the debugger window unless it
- ;; is going to have some relevant information.
- (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
- (string-match "--tty" cmd))
- (split-window-below))
- (switch-to-buffer buffer)
- )))
-
-(defun ada-reread-prj-file (&optional filename)
- "Reread either the current project, or FILENAME if non-nil.
-If FILENAME is non-nil, set it as current project."
- (interactive "P")
- (if (not filename)
- (setq filename ada-prj-default-project-file))
- (ada-parse-prj-file filename)
- (ada-select-prj-file filename))
-
-;; ------ Private routines
-
-(defun ada-xref-current (file &optional ali-file-name)
- "Update the cross-references for FILE.
-This in fact recompiles FILE to create ALI-FILE-NAME.
-This function returns the name of the file that was recompiled to generate
-the cross-reference information. Note that the ali file can then be deduced
-by replacing the file extension with `.ali'."
- ;; kill old buffer
- (if (and ali-file-name
- (get-file-buffer ali-file-name))
- (kill-buffer (get-file-buffer ali-file-name)))
-
- (let* ((name (convert-standard-filename file))
- (body-name (or (ada-get-body-name name) name)))
-
- ;; Always recompile the body when we can. We thus temporarily switch to a
- ;; buffer than contains the body of the unit
- (save-excursion
- (let ((body-visible (find-buffer-visiting body-name))
- process)
- (if body-visible
- (set-buffer body-visible)
- (find-file body-name))
-
- ;; Execute the compilation. Note that we must wait for the end of the
- ;; process, or the ALI file would still not be available.
- ;; Unfortunately, the underlying `compile' command that we use is
- ;; asynchronous.
- (ada-compile-current)
- (setq process (get-buffer-process "*compilation*"))
-
- (while (and process
- (not (equal (process-status process) 'exit)))
- (sit-for 1))
-
- ;; remove the buffer for the body if it wasn't there before
- (unless body-visible
- (kill-buffer (find-buffer-visiting body-name)))
- ))
- body-name))
-
-(defun ada-find-file-in-dir (file dir-list)
- "Search for FILE in DIR-LIST."
- (let (found)
- (while (and (not found) dir-list)
- (setq found (concat (file-name-as-directory (car dir-list))
- (file-name-nondirectory file)))
-
- (unless (file-exists-p found)
- (setq found nil))
- (setq dir-list (cdr dir-list)))
- found))
-
-(defun ada-find-ali-file-in-dir (file)
- "Find the ali file FILE, searching obj_dir for the current project.
-Adds build_dir in front of the search path to conform to gnatmake's behavior,
-and the standard runtime location at the end."
- (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
-
-(defun ada-find-src-file-in-dir (file)
- "Find the source file FILE, searching src_dir for the current project.
-Adds the standard runtime location at the end of the search path to conform
-to gnatmake's behavior."
- (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
-
-(defun ada-get-ali-file-name (file)
- "Create the ali file name for the Ada file FILE.
-The file is searched for in every directory shown in the obj_dir lines of
-the project file."
-
- ;; This function has to handle the special case of non-standard
- ;; file names (i.e. not .adb or .ads)
- ;; The trick is the following:
- ;; 1- replace the extension of the current file with .ali,
- ;; and look for this file
- ;; 2- If this file is found:
- ;; grep the "^U" lines, and make sure we are not reading the
- ;; .ali file for a spec file. If we are, go to step 3.
- ;; 3- If the file is not found or step 2 failed:
- ;; find the name of the "other file", ie the body, and look
- ;; for its associated .ali file by substituting the extension
- ;;
- ;; We must also handle the case of separate packages and subprograms:
- ;; 4- If no ali file was found, we try to modify the file name by removing
- ;; everything after the last '-' or '.' character, so as to get the
- ;; ali file for the parent unit. If we found an ali file, we check that
- ;; it indeed contains the definition for the separate entity by checking
- ;; the 'D' lines. This is done repeatedly, in case the direct parent is
- ;; also a separate.
-
- (with-current-buffer (get-file-buffer file)
- (let ((short-ali-file-name (concat (file-name-base file) ".ali"))
- ali-file-name
- is-spec)
-
- ;; If we have a non-standard file name, and this is a spec, we first
- ;; look for the .ali file of the body, since this is the one that
- ;; contains the most complete information. If not found, we will do what
- ;; we can with the .ali file for the spec...
-
- (if (not (string= (file-name-extension file) "ads"))
- (let ((specs ada-spec-suffixes))
- (while specs
- (if (string-match (concat (regexp-quote (car specs)) "$")
- file)
- (setq is-spec t))
- (setq specs (cdr specs)))))
-
- (if is-spec
- (setq ali-file-name
- (ada-find-ali-file-in-dir
- (concat (file-name-base (ada-other-file-name)) ".ali"))))
-
-
- (setq ali-file-name
- (or ali-file-name
-
- ;; Else we take the .ali file associated with the unit
- (ada-find-ali-file-in-dir short-ali-file-name)
-
-
- ;; else we did not find the .ali file Second chance: in case
- ;; the files do not have standard names (such as for instance
- ;; file_s.ada and file_b.ada), try to go to the other file
- ;; and look for its ali file
- (ada-find-ali-file-in-dir
- (concat (file-name-base (ada-other-file-name)) ".ali"))
-
-
- ;; If we still don't have an ali file, try to get the one
- ;; from the parent unit, in case we have a separate entity.
- (let ((parent-name (file-name-base file)))
-
- (while (and (not ali-file-name)
- (string-match "^\\(.*\\)[.-][^.-]*" parent-name))
-
- (setq parent-name (match-string 1 parent-name))
- (setq ali-file-name (ada-find-ali-file-in-dir
- (concat parent-name ".ali")))
- )
- ali-file-name)))
-
- ;; If still not found, try to recompile the file
- (if (not ali-file-name)
- ;; Recompile only if the user asked for this, and search the ali
- ;; filename again. We avoid a possible infinite recursion by
- ;; temporarily disabling the automatic compilation.
-
- (if ada-xref-create-ali
- (setq ali-file-name
- (concat (file-name-sans-extension (ada-xref-current file))
- ".ali"))
-
- (error "`.ali' file not found; recompile your source file"))
-
-
- ;; same if the .ali file is too old and we must recompile it
- (if (and (file-newer-than-file-p file ali-file-name)
- ada-xref-create-ali)
- (ada-xref-current file ali-file-name)))
-
- ;; Always return the correct absolute file name
- (expand-file-name ali-file-name))
- ))
-
-(defun ada-get-ada-file-name (file original-file)
- "Create the complete file name (+directory) for FILE.
-The original file (where the user was) is ORIGINAL-FILE.
-Search in project file for possible paths."
-
- (save-excursion
-
- ;; If the buffer for original-file, use it to get the values from the
- ;; project file, otherwise load the file and its project file
- (let ((buffer (get-file-buffer original-file)))
- (if buffer
- (set-buffer buffer)
- (find-file original-file)))
-
- ;; we choose the first possible completion and we
- ;; return the absolute file name
- (let ((filename (ada-find-src-file-in-dir file)))
- (if filename
- (expand-file-name filename)
- (signal 'ada-error-file-not-found (file-name-nondirectory file)))
- )))
-
-(defun ada-find-file-number-in-ali (file)
- "Return the file number for FILE in the associated ali file."
- (set-buffer (ada-get-ali-buffer file))
- (goto-char (point-min))
-
- (let ((begin (re-search-forward "^D")))
- (beginning-of-line)
- (re-search-forward (concat "^D " (file-name-nondirectory file)))
- (count-lines begin (point))))
-
-(defun ada-read-identifier (pos)
- "Return the identlist around POS and switch to the .ali buffer.
-The returned list represents the entity, and can be manipulated through the
-macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
-
- ;; If at end of buffer (e.g the buffer is empty), error
- (if (>= (point) (point-max))
- (error "No identifier on point"))
-
- ;; goto first character of the identifier/operator (skip backward < and >
- ;; since they are part of multiple character operators
- (goto-char pos)
- (skip-chars-backward "a-zA-Z0-9_<>")
-
- ;; check if it really is an identifier
- (if (ada-in-comment-p)
- (error "Inside comment"))
-
- (let (identifier identlist)
- ;; Just in front of a string => we could have an operator declaration,
- ;; as in "+", "-", ..
- (if (= (char-after) ?\")
- (forward-char 1))
-
- ;; if looking at an operator
- ;; This is only true if:
- ;; - the symbol is +, -, ...
- ;; - the symbol is made of letters, and not followed by _ or a letter
- (if (and (looking-at ada-operator-re)
- (or (not (= (char-syntax (char-after)) ?w))
- (not (or (= (char-syntax (char-after (match-end 0))) ?w)
- (= (char-after (match-end 0)) ?_)))))
- (progn
- (if (and (= (char-before) ?\")
- (= (char-after (+ (length (match-string 0)) (point))) ?\"))
- (forward-char -1))
- (setq identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
-
- (if (ada-in-string-p)
- (error "Inside string or character constant"))
- (if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
- (error "No cross-reference available for reserved keyword"))
- (if (looking-at "[a-zA-Z0-9_]+")
- (setq identifier (match-string 0))
- (error "No identifier around")))
-
- ;; Build the identlist
- (setq identlist (ada-make-identlist))
- (ada-set-name identlist (downcase identifier))
- (ada-set-line identlist
- (number-to-string (count-lines 1 (point))))
- (ada-set-column identlist
- (number-to-string (1+ (current-column))))
- (ada-set-file identlist (buffer-file-name))
- identlist
- ))
-
-(defun ada-get-all-references (identlist)
- "Complete IDENTLIST with definition file and places where it is referenced.
-Information is extracted from the ali file."
-
- (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
- declaration-found)
- (set-buffer ali-buffer)
- (goto-char (point-min))
- (ada-set-on-declaration identlist nil)
-
- ;; First attempt: we might already be on the declaration of the identifier
- ;; We want to look for the declaration only in a definite interval (after
- ;; the "^X ..." line for the current file, and before the next "^X" line
-
- (if (re-search-forward
- (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
- nil t)
- (let ((bound (save-excursion (re-search-forward "^X " nil t))))
- (setq declaration-found
- (re-search-forward
- (concat "^" (ada-line-of identlist)
- "." (ada-column-of identlist)
- "[ *]" (ada-name-of identlist)
- "[{[(<= ]?\\(.*\\)$") bound t))
- (if declaration-found
- (ada-set-on-declaration identlist t))
- ))
-
- ;; If declaration is still nil, then we were not on a declaration, and
- ;; have to fall back on other algorithms
-
- (unless declaration-found
-
- ;; Since we already know the number of the file, search for a direct
- ;; reference to it
- (goto-char (point-min))
- (setq declaration-found t)
- (ada-set-ali-index
- identlist
- (number-to-string (ada-find-file-number-in-ali
- (ada-file-of identlist))))
- (unless (re-search-forward (concat (ada-ali-index-of identlist)
- "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)?
\\)*"
- (ada-line-of identlist)
- "[^etpzkd<>=^]"
- (ada-column-of identlist) "\\>")
- nil t)
-
- ;; if we did not find it, it may be because the first reference
- ;; is not required to have a 'unit_number|' item included.
- ;; Or maybe we are already on the declaration...
- (unless (re-search-forward
- (concat
- "^[0-9]+.[0-9]+[ *]"
- (ada-name-of identlist)
- "[ <{=([]\\(.\\|\n\\.\\)*\\<"
- (ada-line-of identlist)
- "[^0-9]"
- (ada-column-of identlist) "\\>")
- nil t)
-
- ;; If still not found, then either the declaration is unknown
- ;; or the source file has been modified since the ali file was
- ;; created
- (setq declaration-found nil)
- )
- )
-
- ;; Last check to be completely sure we have found the correct line (the
- ;; ali might not be up to date for instance)
- (if declaration-found
- (progn
- (beginning-of-line)
- ;; while we have a continuation line, go up one line
- (while (looking-at "^\\.")
- (forward-line -1)
- (beginning-of-line))
- (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
- (ada-name-of identlist) "[ <{=([]"))
- (setq declaration-found nil))))
-
- ;; Still no success ! The ali file must be too old, and we need to
- ;; use a basic algorithm based on guesses. Note that this only happens
- ;; if the user does not want us to automatically recompile files
- ;; automatically
- (unless declaration-found
- (if (ada-xref-find-in-modified-ali identlist)
- (setq declaration-found t)
- ;; No more idea to find the declaration. Give up
- (progn
- (kill-buffer ali-buffer)
-
- (error "No declaration of %s found" (ada-name-of identlist))
- )))
- )
-
-
- ;; Now that we have found a suitable line in the .ali file, get the
- ;; information available
- (beginning-of-line)
- (if declaration-found
- (let ((current-line (buffer-substring
- (point) (point-at-eol))))
- (save-excursion
- (forward-line 1)
- (beginning-of-line)
- (while (looking-at "^\\.\\(.*\\)")
- (setq current-line (concat current-line (match-string 1)))
- (forward-line 1))
- )
-
- (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
-
- ;; If we can find the file
- (condition-case err
- (ada-set-declare-file
- identlist
- (ada-get-ada-file-name (match-string 1)
- (ada-file-of identlist)))
-
- ;; Else clean up the ali file
- (ada-error-file-not-found
- (signal (car err) (cdr err)))
- (error
- (kill-buffer ali-buffer)
- (error (error-message-string err)))
- ))
-
- (ada-set-references identlist current-line)
- ))
- ))
-
-(defun ada-xref-find-in-modified-ali (identlist)
- "Find the matching position for IDENTLIST in the current ali buffer.
-This function is only called when the file was not up-to-date, so we need
-to make some guesses.
-This function is disabled for operators, and only works for identifiers."
-
- (unless (= (string-to-char (ada-name-of identlist)) ?\")
- (progn
- (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
- (my-regexp (concat "[ *]"
- (regexp-quote (ada-name-of identlist)) " "))
- (line-ada "--")
- (col-ada "--")
- (line-ali 0)
- (len 0)
- (choice 0)
- (ali-buffer (current-buffer)))
-
- (goto-char (point-max))
- (while (re-search-backward my-regexp nil t)
- (save-excursion
- (setq line-ali (count-lines 1 (point)))
- (beginning-of-line)
- ;; have a look at the line and column numbers
- (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
- (progn
- (setq line-ada (match-string 1))
- (setq col-ada (match-string 2)))
- (setq line-ada "--")
- (setq col-ada "--")
- )
- ;; construct a list with the file names and the positions within
- (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t)
- (cl-pushnew (list line-ali (match-string 1) line-ada col-ada)
- declist :test #'equal)
- )
- )
- )
-
- ;; how many possible declarations have we found ?
- (setq len (length declist))
- (cond
- ;; none => error
- ((= len 0)
- (kill-buffer (current-buffer))
- (error "No declaration of %s recorded in .ali file"
- (ada-name-of identlist)))
- ;; one => should be the right one
- ((= len 1)
- (goto-char (point-min))
- (forward-line (1- (caar declist))))
-
- ;; more than one => display choice list
- (t
- (save-window-excursion
- (with-output-to-temp-buffer "*choice list*"
-
- (princ "Identifier is overloaded and Xref information is not up
to date.\n")
- (princ "Possible declarations are:\n\n")
- (princ " no. in file at line col\n")
- (princ " --- --------------------- ---- ----\n")
- (let ((counter 0))
- (while (< counter len)
- (princ (format " %2d) %-21s %4s %4s\n"
- (1+ counter)
- (ada-get-ada-file-name
- (nth 1 (nth counter declist))
- (ada-file-of identlist))
- (nth 2 (nth counter declist))
- (nth 3 (nth counter declist))
- ))
- (setq counter (1+ counter))
- ) ; end of while
- ) ; end of let
- ) ; end of with-output-to ...
- (setq choice nil)
- (while (or
- (not choice)
- (not (integerp choice))
- (< choice 1)
- (> choice len))
- (setq choice
- (string-to-number
- (read-from-minibuffer "Enter No. of your choice: "))))
- )
- (set-buffer ali-buffer)
- (goto-char (point-min))
- (forward-line (1- (car (nth (1- choice) declist))))
- ))))))
-
-
-(defun ada-find-in-ali (identlist &optional other-frame)
- "Look in the .ali file for the definition of the identifier in IDENTLIST.
-If OTHER-FRAME is non-nil, and `ada-xref-other-buffer' is non-nil,
-opens a new window to show the declaration."
-
- (ada-get-all-references identlist)
- (let ((ali-line (ada-references-of identlist))
- (locations nil)
- (start 0)
- file line col)
-
- ;; Note: in some cases, an entity can have multiple references to the
- ;; bodies (this is for instance the case for a separate subprogram, that
- ;; has a reference both to the stub and to the real body).
- ;; In that case, we simply go to each one in turn.
-
- ;; Get all the possible locations
- (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line)
- (setq locations (list (list (match-string 1 ali-line) ;; line
- (match-string 2 ali-line) ;; column
- (ada-declare-file-of identlist))))
- (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)"
- ali-line start)
- (setq line (match-string 1 ali-line)
- col (match-string 3 ali-line)
- start (match-end 3))
-
- ;; it there was a file number in the same line
- ;; Make sure we correctly handle the case where the first file reference
- ;; on the line is the type reference.
- ;; 1U2 T(2|2r3) 34r23
- (if (string-match (concat "[^{(<0-9]\\([0-9]+\\)|\\([^|bc]+\\)?"
- (match-string 0 ali-line))
- ali-line)
- (let ((file-number (match-string 1 ali-line)))
- (goto-char (point-min))
- (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
- (string-to-number file-number))
- (setq file (match-string 1))
- )
- ;; Else get the nearest file
- (setq file (ada-declare-file-of identlist)))
-
- (setq locations (append locations (list (list line col file)))))
-
- ;; Add the specs at the end again, so that from the last body we go to
- ;; the specs
- (setq locations (append locations (list (car locations))))
-
- ;; Find the new location we want to go to.
- ;; If we are on none of the locations listed, we simply go to the specs.
-
- (setq line (caar locations)
- col (nth 1 (car locations))
- file (nth 2 (car locations)))
-
- (while locations
- (if (and (string= (caar locations) (ada-line-of identlist))
- (string= (nth 1 (car locations)) (ada-column-of identlist))
- (string= (file-name-nondirectory (nth 2 (car locations)))
- (file-name-nondirectory (ada-file-of identlist))))
- (setq locations (cadr locations)
- line (car locations)
- col (nth 1 locations)
- file (nth 2 locations)
- locations nil)
- (setq locations (cdr locations))))
-
- ;; Find the file in the source path
- (setq file (ada-get-ada-file-name file (ada-file-of identlist)))
-
- ;; Kill the .ali buffer
- (kill-buffer (current-buffer))
-
- ;; Now go to the buffer
- (ada-xref-change-buffer file
- (string-to-number line)
- (1- (string-to-number col))
- identlist
- other-frame)
- ))
-
-(defun ada-find-in-src-path (identlist &optional other-frame)
- "More general function for cross-references.
-This function should be used when the standard algorithm that parses the
-.ali file has failed, either because that file was too old or even did not
-exist.
-This function attempts to find the possible declarations for the identifier
-anywhere in the object path.
-This command requires the external `grep' program to be available.
-
-This works well when one is using an external library and wants to find
-the declaration and documentation of the subprograms one is using."
-;; FIXME: what does this function do?
- (let (list
- (dirs (ada-xref-get-obj-dir-field))
- (regexp (concat "[ *]" (ada-name-of identlist)))
- line column
- choice
- file)
-
- ;; Do the grep in all the directories. We do multiple shell
- ;; commands instead of one in case there is no .ali file in one
- ;; of the directory and the shell stops because of that.
-
- (with-current-buffer (get-buffer-create "*grep*")
- (while dirs
- (insert (shell-command-to-string
- (concat
- "grep -E -i -h "
- (shell-quote-argument (concat "^X|" regexp "( |$)"))
- " "
- (shell-quote-argument (file-name-as-directory (car dirs)))
- "*.ali")))
- (setq dirs (cdr dirs)))
-
- ;; Now parse the output
- (setq case-fold-search t)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (save-excursion
- (beginning-of-line)
- (if (not (= (char-after) ?X))
- (progn
- (looking-at "\\([0-9]+\\).\\([0-9]+\\)")
- (setq line (match-string 1)
- column (match-string 2))
- (re-search-backward "^X [0-9]+ \\(.*\\)$")
- (setq file (list (match-string 1) line column))
-
- ;; There could be duplicate choices, because of the structure
- ;; of the .ali files
- (unless (member file list)
- (setq list (append list (list file))))))))
-
- ;; Current buffer is still "*grep*"
- (kill-buffer "*grep*")
- )
-
- ;; Now display the list of possible matches
- (cond
-
- ;; No choice found => Error
- ((null list)
- (error "No cross-reference found, please recompile your file"))
-
- ;; Only one choice => Do the cross-reference
- ((= (length list) 1)
- (setq file (ada-find-src-file-in-dir (caar list)))
- (if file
- (ada-xref-change-buffer file
- (string-to-number (nth 1 (car list)))
- (string-to-number (nth 2 (car list)))
- identlist
- other-frame)
- (error "%s not found in src_dir" (caar list)))
- (message "This is only a (good) guess at the cross-reference.")
- )
-
- ;; Else, ask the user
- (t
- (save-window-excursion
- (with-output-to-temp-buffer "*choice list*"
-
- (princ "Identifier is overloaded and Xref information is not up to
date.\n")
- (princ "Possible declarations are:\n\n")
- (princ " no. in file at line col\n")
- (princ " --- --------------------- ---- ----\n")
- (let ((counter 0))
- (while (< counter (length list))
- (princ (format " %2d) %-21s %4s %4s\n"
- (1+ counter)
- (nth 0 (nth counter list))
- (nth 1 (nth counter list))
- (nth 2 (nth counter list))
- ))
- (setq counter (1+ counter))
- )))
- (setq choice nil)
- (while (or (not choice)
- (not (integerp choice))
- (< choice 1)
- (> choice (length list)))
- (setq choice
- (string-to-number
- (read-from-minibuffer "Enter No. of your choice: "))))
- )
- (setq choice (1- choice))
- (kill-buffer "*choice list*")
-
- (setq file (ada-find-src-file-in-dir (car (nth choice list))))
- (if file
- (ada-xref-change-buffer file
- (string-to-number (nth 1 (nth choice list)))
- (string-to-number (nth 2 (nth choice list)))
- identlist
- other-frame)
- (signal 'ada-error-file-not-found (car (nth choice list))))
- (message "This is only a (good) guess at the cross-reference.")
- ))))
-
-(defun ada-xref-change-buffer
- (file line column identlist &optional other-frame)
- "Select and display FILE, at LINE and COLUMN.
-If we do not end on the same identifier as IDENTLIST, find the
-closest match. Kills the .ali buffer at the end.
-If OTHER-FRAME is non-nil, creates a new frame to show the file."
-
- (let (declaration-buffer)
-
- ;; Select and display the destination buffer
- (if ada-xref-other-buffer
- (if other-frame
- (find-file-other-frame file)
- (setq declaration-buffer (find-file-noselect file))
- (set-buffer declaration-buffer)
- (switch-to-buffer-other-window declaration-buffer)
- )
- (find-file file)
- )
-
- ;; move the cursor to the correct position
- (push-mark)
- (goto-char (point-min))
- (forward-line (1- line))
- (move-to-column column)
-
- ;; If we are not on the identifier, the ali file was not up-to-date.
- ;; Try to find the nearest position where the identifier is found,
- ;; this is probably the right one.
- (unless (looking-at (ada-name-of identlist))
- (ada-xref-search-nearest (ada-name-of identlist)))
- ))
-
-
-(defun ada-xref-search-nearest (name)
- "Search for NAME nearest to the position recorded in the Xref file.
-Return the position of the declaration in the buffer, or nil if not found."
- (let ((orgpos (point))
- (newpos nil)
- (diff nil))
-
- (goto-char (point-max))
-
- ;; loop - look for all declarations of name in this file
- (while (search-backward name nil t)
-
- ;; check if it really is a complete Ada identifier
- (if (and
- (not (save-excursion
- (goto-char (match-end 0))
- (looking-at "_")))
- (not (ada-in-string-or-comment-p))
- (or
- ;; variable declaration ?
- (save-excursion
- (skip-chars-forward "a-zA-Z_0-9" )
- (ada-goto-next-non-ws)
- (looking-at ":[^=]"))
- ;; procedure, function, task or package declaration ?
- (save-excursion
- (ada-goto-previous-word)
- (looking-at
"\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>"))))
-
- ;; check if it is nearer than the ones before if any
- (if (or (not diff)
- (< (abs (- (point) orgpos)) diff))
- (progn
- (setq newpos (point)
- diff (abs (- newpos orgpos))))))
- )
-
- (if newpos
- (progn
- (message "ATTENTION: this declaration is only a (good) guess ...")
- (goto-char newpos))
- nil)))
-
-
-;; Find the parent library file of the current file
-(defun ada-goto-parent ()
- "Go to the parent library file."
- (interactive)
- (ada-require-project-file)
-
- (let ((buffer (ada-get-ali-buffer (buffer-file-name)))
- (unit-name nil)
- (body-name nil)
- (ali-name nil))
- (with-current-buffer buffer
- (goto-char (point-min))
- (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)")
- (setq unit-name (match-string 1))
- (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name))
- (progn
- (kill-buffer buffer)
- (error "No parent unit !"))
- (setq unit-name (match-string 1 unit-name))
- )
-
- ;; look for the file name for the parent unit specification
- (goto-char (point-min))
- (re-search-forward (concat "^W " unit-name
- "%s[ \t]+\\([^ \t]+\\)[ \t]+"
- "\\([^ \t\n]+\\)"))
- (setq body-name (match-string 1))
- (setq ali-name (match-string 2))
- (kill-buffer buffer)
- )
-
- (setq ali-name (ada-find-ali-file-in-dir ali-name))
-
- (save-excursion
- ;; Tries to open the new ali file to find the spec file
- (if ali-name
- (progn
- (find-file ali-name)
- (goto-char (point-min))
- (re-search-forward (concat "^U " unit-name "%s[ \t]+"
- "\\([^ \t]+\\)"))
- (setq body-name (match-string 1))
- (kill-buffer (current-buffer))
- )
- )
- )
-
- (find-file body-name)
- ))
-
-(defun ada-make-filename-from-adaname (adaname)
- "Determine the filename in which ADANAME is found.
-This is a GNAT specific function that uses gnatkrunch."
- (let ((krunch-buf (generate-new-buffer "*gkrunch*"))
- (cross-prefix (plist-get (cdr (ada-xref-current-project))
'cross_prefix)))
- (with-current-buffer krunch-buf
- ;; send adaname to external process `gnatkr'.
- ;; Add a dummy extension, since gnatkr versions have two different
- ;; behaviors depending on the version:
- ;; Up to 3.15: "AA.BB.CC" => aa-bb-cc
- ;; After: "AA.BB.CC" => aa-bb.cc
- (call-process (concat cross-prefix "gnatkr") nil krunch-buf nil
- (concat adaname ".adb") ada-krunch-args)
- ;; fetch output of that process
- (setq adaname (buffer-substring
- (point-min)
- (progn
- (goto-char (point-min))
- (end-of-line)
- (point))))
- ;; Remove the extra extension we added above
- (setq adaname (substring adaname 0 -4))
-
- (kill-buffer krunch-buf)))
- adaname
- )
-
-(defun ada-make-body-gnatstub (&optional interactive)
- "Create an Ada package body in the current buffer.
-This function uses the `gnat stub' program to create the body.
-This function typically is to be hooked into `ff-file-created-hook'.
-If INTERACTIVE is nil, assume this is called from `ff-file-created-hook'."
- (interactive "p")
- (ada-require-project-file)
-
- ;; If not interactive, assume we are being called from
- ;; ff-file-created-hook. Then the current buffer is for the body
- ;; file, but we will create a new one after gnat stub runs
- (unless interactive
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))
-
- (save-some-buffers nil nil)
-
- ;; Make sure the current buffer is the spec, so gnat stub gets the
- ;; right package parameter (this might not be the case if for
- ;; instance the user was asked for a project file)
-
- (unless (buffer-file-name (car (buffer-list)))
- (set-buffer (cadr (buffer-list))))
-
- ;; Call the external process
- (let* ((project-plist (cdr (ada-xref-current-project)))
- (gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
- (gpr-file (plist-get project-plist 'gpr_file))
- (filename (buffer-file-name (car (buffer-list))))
- (output (concat (file-name-sans-extension filename) ".adb"))
- (cross-prefix (plist-get project-plist 'cross_prefix))
- (gnatstub-cmd (concat cross-prefix "gnat stub"
- (if (not (string= gpr-file ""))
- (concat " -P\"" gpr-file "\""))
- " " gnatstub-opts " " filename))
- (buffer (get-buffer-create "*gnat stub*")))
-
- (with-current-buffer buffer
- (compilation-minor-mode 1)
- (erase-buffer)
- (insert gnatstub-cmd)
- (newline)
- )
-
- (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
-
- ;; clean up the output
-
- (if (file-exists-p output)
- (progn
- (find-file output)
- (kill-buffer buffer))
-
- ;; file not created; display the error message
- (display-buffer buffer))))
-
-(defun ada-xref-initialize ()
- "Function called by `ada-mode-hook' to initialize the ada-xref.el package.
-For instance, it creates the gnat-specific menus, sets some hooks for
-`find-file'."
- (remove-hook 'ff-file-created-hook 'ada-make-body) ; from global hook
- (remove-hook 'ff-file-created-hook 'ada-make-body t) ; from local hook
- (add-hook 'ff-file-created-hook 'ada-make-body-gnatstub nil t)
-
- ;; Completion for file names in the mini buffer should ignore .ali files
- (add-to-list 'completion-ignored-extensions ".ali")
-
- (ada-xref-update-project-menu)
- )
-
-;; ----- Add to ada-mode-hook ---------------------------------------------
-
-;; This must be done before initializing the Ada menu.
-(add-hook 'ada-mode-hook 'ada-xref-initialize)
-
-;; Define a new error type
-(define-error 'ada-error-file-not-found
- "File not found in src-dir (check project file): " 'ada-mode-errors)
-
-(provide 'ada-xref)
-
-;;; ada-xref.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master a13c642: Delete built-in ada-mode; Gnu ELPA is a good replacement,
Stephen Leake <=