@title{Ada Mode}
@sp 2
@subtitle An Emacs major mode for programming in Ada
-@subtitle Ada Mode Version 3.7
+@subtitle Ada Mode Version 4.00
@sp 2
@page
@vskip 0pt plus 1filll
* 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.
+* GNU Free Documentation License:: The license for this documentation.
* Index::
@end menu
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_unit} project file variable;
+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.
runs faster than full compile mode, speeding up finding and fixing
compilation errors.
-This sets @code{main_unit} only if it has not been set yet.
+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_unit}.
+This does not set @code{main}.
@item Set main and Build
-Sets @code{main_unit} to the current file, then executes the Build
+Sets @code{main} to the current file, then executes the Build
command.
@item Show main
-Display @code{main_unit} in the message buffer.
+Display @code{main} in the message buffer.
@item Build
-Compiles all obsolete units of the current @code{main_unit}, and links
-@code{main_unit}, by running @code{make_cmd} from the current project.
+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_unit} only if it has not been set yet.
+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
@end table
It is important when using these commands to understand how
-@code{main_unit} is used and changed.
+@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
this case, @key{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_unit}:
+There are three ways to change @code{main}:
@enumerate
@item
-Invoke @key{Ada | Set main and Build}, which sets @code{main_unit} to
+Invoke @key{Ada | Set main and Build}, which sets @code{main} to
the current file.
@item
-Invoke @key{Ada | Project | Edit}, edit @code{main_unit} and
+Invoke @key{Ada | Project | Edit}, edit @code{main} and
@code{main}, and click @key{[save]}
@item
-Invoke @key{Ada | Project | Load}, and load a project file that specifies @code{main_unit}
+Invoke @key{Ada | Project | Load}, and load a project file that specifies @code{main}
@end enumerate
and other things on a per-project basis.
Note that Ada mode project files @samp{*.adp} are different than GNAT
-compiler project files @samp{*.gpr}.
+compiler project files @samp{*.gpr}. However, Emacs Ada mode can use a
+GNAT project 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::
To change the project file before or after the first one is found,
invoke @key{Ada | Project | Load ...}.
-Or, in lisp, evaluate @code{ada-set-default-project-file "/path/file.adp"}.
+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 @key{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, Project file variables, Project File Overview, Project files
@section GUI Editor
@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.
-@c defined in ada-xref-set-default-prj-values; same order here
@table @asis
-@item @code{build_dir} [default: @code{"."}]
-The compile commands will be issued in this directory.
+@c defined in ada-default-prj-properties; alphabetical order
-@item @code{src_dir} [default: @code{"."}]
-A list of directories to search for source files, both for compile
-commands and source navigation.
+@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.
-@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.
+Lisp variable: @code{ada-prj-ada-project-path-sep}.
-The compiler commands must place the @samp{.ali} files in one of these
-directories; the default commands do that.
+@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
+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
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
Lisp variable: @code{ada-prj-default-comp-opt}.
-@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{link_opt} [default: @code{""}]
-Holds user linker options; used in the default build commands.
+@item @code{cross_prefix} [default: @code{""}]
+Name of target machine in a cross-compilation environment. Used in
+default compile and build commands.
-Lisp variable: @code{ada-prj-default-link-opt}.
+@item @code{debug_cmd} [default: @code{"$@{cross_prefix@}gdb $@{main@}"}]
+Command used to debug the application
-@item @code{gnatmake_opt} [default: @code{"-g"}]
-Holds user gnatmake options; used in the default build commands.
+Lisp variable: @code{ada-prj-default-debugger}.
-If a GNAT project file is used (for example @file{project.gpr}), this
-option should be set to @code{-Pproject.gpr}.
+@item @code{debug_post_cmd} [default: @code{""}]
+Command executed after @code{debug_cmd}.
-Lisp variable: @code{ada-prj-default-gnatmake-opt}.
+@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{main} [default: current file]
-Specifies the name of the executable file for the project; used in the
-default build commands.
+@item @code{gnatmake_opt} [default: @code{"-g"}]
+Holds user gnatmake options; used in the default build commands.
-@item @code{main_unit} [default: current Ada unit]
-Specifies the name of the main Ada unit for the project; used in the
-default build commands.
+Lisp variable: @code{ada-prj-default-gnatmake-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{gpr_file} [default: @code{""}]
+Specify GNAT project file.
-@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.
+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.
-@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}.
+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-comp-cmd}.
+Lisp variable: @code{ada-prj-default-gpr-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}.
+@c FIXME: add gnatstub-opts
-Lisp variable: @code{ada-prj-default-check-cmd}
+@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{make_cmd} [default: @code{"$@{cross_prefix@}gnatmake -o $@{main@} $@{main_unit@} $@{gnatmake_opt@} -cargs $@{comp_opt@} -bargs $@{bind_opt@} -largs $@{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{run_cmd} [default: @code{"./$@{main@}"}]
-Command used to run the application.
+@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.
-@item @code{debug_pre_cmd} [default: @code{"cd $@{build_dir@}"}]
-Command executed before @code{debug_cmd}.
+The compiler commands must place the @samp{.ali} files in one of these
+directories; the default commands do that.
-@item @code{debug_cmd} [default: @code{"$@{cross_prefix@}gdb $@{main@}"}]
-Command used to debug the application
+@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.
-Lisp variable: @code{ada-prj-default-debugger}.
+@item @code{run_cmd} [default: @code{"./$@{main@}"}]
+Command used to run the application.
-@item @code{debug_post_cmd} [default: @code{""}]
-Command executed after @code{debug_cmd}.
+@item @code{src_dir} [default: @code{"."}]
+A list of directories to search for source files, both for compile
+commands and source navigation.
@end table
* 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, Set compiler options, Compiling Examples, Compiling Examples
end Hello_2;
@end example
+This file has no errors.
+
@file{hello_pkg.ads}:
@example
end Hello_Pkg;
@end example
+This file has no errors.
+
@file{hello_pkg.adb}:
@example
Ada.Text_IO.Put_Line ("hello from hello.adb"):
@end example
-Now invoke @key{Ada | Show main}; this displays @file{Ada mode main_unit: hello}.
+Now invoke @key{Ada | Show main}; this displays @file{Ada mode main: hello}.
Now (in buffer @file{hello.adb}), invoke @key{Ada | Build}. You are
prompted to save the file (if you haven't already). Then the
@xref{Set source search path}, or a GNAT project file; @ref{Use GNAT
project file}.
-Invoke @key{Ada | Show main}; this displays @file{Ada mode main_unit: hello_2}.
+Invoke @key{Ada | Show main}; this displays @file{Ada mode main: hello_2}.
Move to the error with @key{C-x `}, and fix the error by adding @code{body}:
Now, while still in @file{hello_pkg.adb}, invoke @key{Ada | Build}.
gnatmake successfully builds @file{hello_2}. This demonstrates that
Emacs has remembered the main file, in the project variable
-@code{main_unit}, and used it for the Build command.
+@code{main}, and used it for the Build command.
Finally, again while in @file{hello_pkg.adb}, invoke @key{Ada | Run}.
The @code{*run*} buffer displays @code{Hello from hello_pkg.adb}.
One final point. If you switch back to buffer @file{hello.adb}, and
invoke @key{Ada | Run}, @file{hello_2.exe} will be run. That is
-because @code{main_unit} is still set to @code{hello_2}, as you can
+because @code{main} is still set to @code{hello_2}, as you can
see when you invoke @key{Ada | Project | Edit}.
-There are three ways to change @code{main_unit}:
+There are three ways to change @code{main}:
@enumerate
@item
-Invoke @key{Ada | Set main and Build}, which sets @code{main_unit} to
+Invoke @key{Ada | Set main and Build}, which sets @code{main} to
the current file.
@item
-Invoke @key{Ada | Project | Edit}, edit @code{main_unit} and
+Invoke @key{Ada | Project | Edit}, edit @code{main} and
@code{main}, and click @key{[save]}
@item
-Invoke @key{Ada | Project | Load}, and load a project file that specifies @code{main_unit}
+Invoke @key{Ada | Project | Load}, and load a project file that specifies @code{main}
@end enumerate
@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)
+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:
Fixing the error, linking and running the code proceed as in @ref{No
project files}.
-@node Use GNAT project file, , Set source search path, Compiling Examples
+@node Use GNAT project file, Use multiple GNAT project files, Set source search path, Compiling Examples
@section Use GNAT project file
-In this example, we show how to use a 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:
In addition, create a directory @file{Example_4/Gnat_Project},
containing these files:
-@file{Other/hello_4.adb}:
+@file{Gnat_Project/hello_4.adb}:
@example
with Hello_Pkg;
There are no errors in this file.
-@file{Gnat_Project/hello_4.adp}:
-
-@example
-src_dir=..
-gnatmake_opt=-Phello_4.gpr
-@end example
-
@file{Gnat_Project/hello_4.gpr}:
@example
@end example
In buffer @file{hello_4.adb}, invoke @key{Ada | Project | Load...}, and
-select @file{Example_4/Gnat_Project/hello_4.adp}.
+select @file{Example_4/Gnat_Project/hello_4.gpr}.
Then, again in @file{hello_4.adb}, invoke @key{Ada | Set main and
Build}. You should get a @code{*compilation*} buffer containing
Fixing the error, linking and running the code proceed as in @ref{No
project files}.
+@node Use multiple GNAT project files, , Use GNAT project file, Compiling Examples
+@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 @key{Ada | Project | Load...}, and
+select @file{Example_5/hello_5.adp}.
+
+Then, again in @file{hello_5.adb}, invoke @key{Ada | Set main and
+Build}. You should get a @code{*compilation*} buffer containing
+something like (the directory paths will be different):
+
+@example
+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 example
+
+Now type @key{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, Identifier completion, Compiling Examples, Top
@chapter Moving Through Ada Code
-@c -----------------------------------------------------------------------
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
(defun ada-mode-version ()
"Return Ada mode version."
(interactive)
- (let ((version-string "3.7"))
+ (let ((version-string "4.00"))
(if (interactive-p)
(message version-string)
version-string)))
(concat "\\("
";" "\\|"
"=>[ \t]*$" "\\|"
+ "=>[ \t]*--.*$" "\\|"
"^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|"
"\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
"loop" "private" "record" "select"
;; set source marker
(save-excursion
- (compilation-find-file (point-marker) (match-string 1) "./")
- (set-buffer file)
+ (compilation-find-file (point-marker) (match-string 1) "./")
+ (set-buffer file)
- (if (stringp line)
- (goto-line (string-to-number line)))
+ (if (stringp line)
+ (goto-line (string-to-number line)))
- (setq source (point-marker)))
+ (setq source (point-marker)))
(compilation-goto-locus error-pos source nil)
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- buffer-file-name buffer-file-truename)
+ (inhibit-modification-hooks t))
(remove-text-properties (point-min) (point-max) '(syntax-table nil))
(goto-char (point-min))
(while (re-search-forward
(set (make-local-variable 'fill-paragraph-function)
'ada-fill-comment-paragraph)
- (set (make-local-variable 'imenu-generic-expression)
- ada-imenu-generic-expression)
-
;; Support for compile.el
;; We just substitute our own functions to go to the error.
(add-hook 'compilation-mode-hook
'ada-compile-goto-error)))
;; font-lock support :
- ;; We need to set some properties for XEmacs, and define some variables
- ;; for Emacs
- ;; FIXME: The Emacs code should work just fine under XEmacs AFAIK. --Stef
- (if (featurep 'xemacs)
- ;; XEmacs
- (put 'ada-mode 'font-lock-defaults
- '(ada-font-lock-keywords
- nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
- ;; Emacs
- (set (make-local-variable 'font-lock-defaults)
- '(ada-font-lock-keywords
- nil t
- ((?\_ . "w") (?# . "."))
- beginning-of-line
- (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
- )
+ (set (make-local-variable 'font-lock-defaults)
+ '(ada-font-lock-keywords
+ nil t
+ ((?\_ . "w") (?# . "."))
+ beginning-of-line
+ (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
;; Set up support for find-file.el.
(set (make-local-variable 'ff-other-file-alist)
(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)))
- ))
+ (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)
(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
;; Exclude comments alone on line from alignment.
(add-to-list 'align-exclude-rules-list
- '(ada-solo-comment
- (regexp . "^\\(\\s-*\\)--")
- (modes . '(ada-mode))))
+ '(ada-solo-comment
+ (regexp . "^\\(\\s-*\\)--")
+ (modes . '(ada-mode))))
(add-to-list 'align-exclude-rules-list
- '(ada-solo-use
- (regexp . "^\\(\\s-*\\)\\<use\\>")
- (modes . '(ada-mode))))
+ '(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))))
+ '(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))))
+ '(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))))
+ '(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))))
+ '(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))))
+ '(ada-at
+ (regexp . "\\(\\s-+\\)at\\>")
+ (modes . '(ada-mode))))
(setq align-mode-rules-list ada-align-modes)
;; 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)
+
(setq major-mode 'ada-mode
mode-name "Ada")
Assumes point to be already positioned by `ada-goto-matching-start'.
Moves point to the beginning of the declaration."
- ;; named block without a `declare'
+ ;; 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 ; do nothing
+ ;; else
;;
;; 'accept' or 'package' ?
;;
;; a named 'declare'-block ? => jump to the label
;;
(if (looking-at "\\<declare\\>")
- (backward-word 1)
+ (progn
+ (forward-comment -1)
+ (backward-word 1))
;;
;; no, => 'procedure'/'function'/'task'/'protected'
;;
(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))))
+ (setq ff-function-name (match-string 5)))
+ (if (re-search-backward ada-package-start-regexp nil t)
+ (setq ff-function-name (match-string 4))))
))
;; 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)))))
"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)
+ "then" "until" "when" "while" "with" "xor") t)
"\\>")
;;
;; Anything following end and not already fontified is a body name.
(insert "end " procname ";")
(ada-indent-newline-indent)
)
- ;; else
+
((looking-at "[ \t\n]*is")
;; do nothing
)
+
((looking-at "[ \t\n]*rename")
;; do nothing
)
+
(t
(message "unknown syntax"))))
(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 nil)
(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)
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.
"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
+ (if (or (equal system-type 'windows-nt)
+ (equal system-type 'ms-dos))
+ ";"
+ ":")
+ "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
:type 'string :group 'ada)
(defcustom ada-prj-default-make-cmd
- (concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} "
+ (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."
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-xref-set-default-prj-values' for the list of valid properties.
+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
(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"
- (or (ada-find-file-in-dir exec-name exec-path)
- (ada-find-file-in-dir (concat exec-name ".exe") exec-path)
- exec-name))
+ (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."
- (save-excursion
- (setq ada-xref-runtime-library-specs-path '()
- ada-xref-runtime-library-ali-path '())
- (set-buffer (get-buffer-create "*gnatls*"))
- (widen)
- (erase-buffer)
- ;; Catch any error in the following form (i.e gnatls was not found)
- (condition-case nil
- ;; Even if we get an error, delete the *gnatls* buffer
- (unwind-protect
- (progn
- (let ((gnatls
- (ada-find-executable (concat cross-prefix "gnatls"))))
- (apply 'call-process gnatls (append '(nil t nil) ada-gnatls-args)))
- (goto-char (point-min))
-
- ;; Source path
-
- (search-forward "Source Search Path:")
- (forward-line 1)
- (while (not (looking-at "^$"))
- (back-to-indentation)
- (if (looking-at "<Current_Directory>")
- (add-to-list 'ada-xref-runtime-library-specs-path ".")
- (add-to-list 'ada-xref-runtime-library-specs-path
- (buffer-substring-no-properties
- (point)
+ (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)
+ (if (looking-at "<Current_Directory>")
+ (add-to-list 'ada-xref-runtime-library-specs-path ".")
+ (add-to-list 'ada-xref-runtime-library-specs-path
+ (buffer-substring-no-properties
+ (point)
(save-excursion (end-of-line) (point)))))
- (forward-line 1))
-
- ;; Object path
-
- (search-forward "Object Search Path:")
- (forward-line 1)
- (while (not (looking-at "^$"))
- (back-to-indentation)
- (if (looking-at "<Current_Directory>")
- (add-to-list 'ada-xref-runtime-library-ali-path ".")
- (add-to-list 'ada-xref-runtime-library-ali-path
- (buffer-substring-no-properties
- (point)
- (save-excursion (end-of-line) (point)))))
- (forward-line 1))
- )
- (kill-buffer nil))
- (error nil))
+ (forward-line 1))
+
+ ;; Object path
+
+ (search-forward "Object Search Path:")
+ (forward-line 1)
+ (while (not (looking-at "^$"))
+ (back-to-indentation)
+ (if (looking-at "<Current_Directory>")
+ (add-to-list 'ada-xref-runtime-library-ali-path ".")
+ (add-to-list 'ada-xref-runtime-library-ali-path
+ (buffer-substring-no-properties
+ (point)
+ (save-excursion (end-of-line) (point)))))
+ (forward-line 1))
+ )
+ (kill-buffer nil))))
+
(set 'ada-xref-runtime-library-specs-path
(reverse ada-xref-runtime-library-specs-path))
(set '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.
+Returns 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."
+ (save-excursion
+ (set-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
+ (if (looking-at "<Current_Directory>")
+ (add-to-list 'src-dir (expand-file-name "."))
+ (add-to-list 'src-dir
+ (expand-file-name
+ (buffer-substring-no-properties
+ (point) (line-end-position)))))
+ (forward-line 1))
+
+ ;; Object path
+
+ (search-forward "Object Search Path:")
+ (forward-line 1)
+ (while (not (looking-at "^$"))
+ (back-to-indentation)
+ (if (looking-at "<Current_Directory>")
+ (add-to-list 'obj-dir (expand-file-name "."))
+ (add-to-list 'obj-dir
+ (expand-file-name
+ (buffer-substring-no-properties
+ (point) (line-end-position)))))
+ (forward-line 1))
+
+ ;; Set properties
+ (setq plist (plist-put plist 'gpr_file gpr-file))
+ (setq plist (plist-put plist 'src_dir (reverse src-dir)))
+ (plist-put plist 'obj_dir (reverse obj-dir))
+ )
+ (kill-buffer nil)
+ (message "Parsing %s ... done" gpr-file)
+ )
+ ))
+
(defun ada-treat-cmd-string (cmd-string)
- "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
+ "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
(mapconcat (lambda(x) (concat prefix x)) value " ")
t t cmd-string)))))
))
- cmd-string)
+ (substitute-in-file-name cmd-string))
-(defun ada-xref-set-default-prj-values (symbol ada-buffer)
- "Reset the properties in SYMBOL to the default values for ADA-BUFFER."
-
- (let ((file (buffer-file-name ada-buffer))
- plist)
- (save-excursion
- (set-buffer ada-buffer)
-
- (set 'plist
- ;; Try hard to find a project file, even if the current
- ;; buffer is not an Ada file or not associated with a file
- (list 'filename (expand-file-name
- (cond
- (ada-prj-default-project-file
- ada-prj-default-project-file)
- (file (ada-prj-find-prj-file file t))
- (t
- (message (concat "Not editing an Ada file,"
- "and no default project "
- "file specified!"))
- "")))
- 'build_dir (file-name-as-directory (expand-file-name "."))
- 'src_dir (list ".")
- 'obj_dir (list ".")
- 'casing (if (listp ada-case-exception-file)
- ada-case-exception-file
- (list ada-case-exception-file))
- 'comp_opt ada-prj-default-comp-opt
- 'bind_opt ada-prj-default-bind-opt
- 'link_opt ada-prj-default-link-opt
- 'gnatmake_opt ada-prj-default-gnatmake-opt
- 'gnatfind_opt ada-prj-gnatfind-switches
- 'main (if file
- (file-name-nondirectory
- (file-name-sans-extension file))
- "")
- 'main_unit (if file
- (file-name-nondirectory
- (file-name-sans-extension file))
- "")
- 'cross_prefix ""
- 'remote_machine ""
- 'comp_cmd (list ada-prj-default-comp-cmd)
- 'check_cmd (list ada-prj-default-check-cmd)
- 'make_cmd (list ada-prj-default-make-cmd)
- 'run_cmd (list (concat "./${main}" (if is-windows ".exe")))
- 'debug_pre_cmd (list (concat ada-cd-command " ${build_dir}"))
- 'debug_cmd (concat ada-prj-default-debugger
- " ${main}" (if is-windows ".exe"))
- 'debug_post_cmd (list nil)))
- )
- (set symbol plist)))
(defun ada-xref-get-project-field (field)
"Extract the value of FIELD from the current project file.
which will in addition return the default paths."
(let* ((project-plist (cdr (ada-xref-current-project)))
- value)
+ (value (plist-get project-plist field)))
- (set '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)))))
- ;; Substitute the ${...} constructs in all the strings, including
- ;; inside lists
+ ;; 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))
["New..." ada-prj-new t]
["Edit..." ada-prj-edit t]
"---"
- ;; Add the new items
+ ;; Add the project files
,@(mapcar
(lambda (x)
- (let ((name (or (car x) "<default>"))
- (command `(lambda ()
- "Change the active project file."
- (interactive)
- (ada-parse-prj-file ,(car x))
- (set 'ada-prj-default-project-file ,(car x))
- (ada-xref-update-project-menu))))
+ (let* ((name (or (car x) "<default>"))
+ (command `(lambda ()
+ "Select the current project file."
+ (interactive)
+ (ada-select-prj-file ,name))))
(vector
- (if (string= (file-name-extension name)
- ada-prj-file-extension)
- (file-name-sans-extension
- (file-name-nondirectory name))
- (file-name-nondirectory name))
+ (file-name-nondirectory name)
command
:button (cons
:toggle
(car x))
))))
- ;; Parses all the known project files, and insert at
- ;; least the default one (in case
- ;; ada-xref-project-files is nil)
(or ada-xref-project-files '(nil))))))
(easy-menu-add-item ada-mode-menu '() submenu)))
(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 (not (ada-xref-current-project t))
- (ada-reread-prj-file)))
+ (if (string= "" ada-prj-default-project-file)
+ (ada-reread-prj-file (ada-prj-find-prj-file t))))
-(defun ada-xref-current-project-file (&optional no-user-question)
- "Return the current project file name; never nil unless NO-USER-QUESTION.
-If NO-USER-QUESTION, don't prompt user for file. Call
-`ada-require-project-file' first if a project must exist."
+(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 nil no-user-question)))
+ (ada-prj-find-prj-file t)))
-(defun ada-xref-current-project (&optional no-user-question)
- "Return the current project; nil if none.
-If NO-USER-QUESTION, don't prompt user for file. Call
-`ada-require-project-file' first if a project must exist."
- (let* ((file-name (ada-xref-current-project-file no-user-question)))
+(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 ()
(message (ada-xref-current-project-file)))
(defun ada-show-current-main ()
- "Display current main unit name in message buffer."
+ "Display current main file name in message buffer."
(interactive)
- (message "ada-mode main_unit: %s" (ada-xref-get-project-field 'main_unit)))
+ (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."
name)
;; FIXME: use convert-standard-filename instead
-(defun ada-set-default-project-file (name &optional keep-existing)
- "Set the file whose name is NAME as the default project file.
-If KEEP-EXISTING is true and a project file has already been loaded, nothing
-is done. This is meant to be used from `ada-mode-hook', for instance, to force
-a project file unless the user has already loaded one."
+(defun ada-set-default-project-file (file)
+ "Set FILE as the current project file."
(interactive "fProject file:")
- (if (or (not keep-existing)
- (not ada-prj-default-project-file)
- (equal ada-prj-default-project-file ""))
- (progn
- (setq ada-prj-default-project-file name)
- (ada-reread-prj-file name))))
+ (ada-parse-prj-file file)
+ (ada-select-prj-file file))
;; ------ Handling the project file -----------------------------
-(defun ada-prj-find-prj-file (&optional file no-user-question)
- "Find the project file associated with FILE (or the current buffer if nil).
+(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
(let (selected)
(if (not (and (derived-mode-p 'ada-mode)
- buffer-file-name))
+ buffer-file-name))
;; Not in an Ada buffer, or current buffer not associated
;; with a file (for instance an emerge buffer)
-
- (if (and ada-prj-default-project-file
- (not (string= ada-prj-default-project-file "")))
- (setq selected ada-prj-default-project-file)
- (setq selected nil))
+ (setq selected nil)
;; other cases: use a more complex algorithm
- (let* ((current-file (or file (buffer-file-name)))
+ (let* ((current-file (buffer-file-name))
(first-choice (concat
(file-name-sans-extension current-file)
ada-prj-file-extension))
(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 ""
+ '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 is-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 is-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 it as the active project."
- ;; FIXME: doc nil, search, etc.
- (if prj-file
- (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing
- run_cmd debug_pre_cmd debug_post_cmd
- (ada-buffer (current-buffer)))
- (setq prj-file (expand-file-name prj-file))
-
- ;; Set the project file as the active one.
- (setq ada-prj-default-project-file prj-file)
-
- ;; Initialize the project with the default values
- (ada-xref-set-default-prj-values 'project (current-buffer))
-
- ;; Do not use find-file below, since we don't want to show this
- ;; buffer. If the file is open through speedbar, we can't use
- ;; find-file anyway, since the speedbar frame is special and does not
- ;; allow the selection of a file in it.
-
- (if (file-exists-p prj-file)
- (progn
- (let* ((buffer (run-hook-with-args-until-success
- 'ada-load-project-hook prj-file)))
- (unless buffer
- (setq buffer (find-file-noselect prj-file nil)))
- (set-buffer buffer))
-
- (widen)
- (goto-char (point-min))
-
- ;; Now overrides these values with the project file
- (while (not (eobp))
- (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
- (cond
- ;; fields that are lists or paths require special processing
- ;; FIXME: strip trailing spaces
- ((string= (match-string 1) "src_dir")
- (add-to-list 'src_dir
- (file-name-as-directory (match-string 2))))
- ((string= (match-string 1) "obj_dir")
- (add-to-list 'obj_dir
- (file-name-as-directory (match-string 2))))
- ((string= (match-string 1) "casing")
- (set 'casing (cons (match-string 2) casing)))
- ((string= (match-string 1) "build_dir")
- (set 'project
- (plist-put project 'build_dir
- (file-name-as-directory (match-string 2)))))
- ((string= (match-string 1) "make_cmd")
- (add-to-list 'make_cmd (match-string 2)))
- ((string= (match-string 1) "comp_cmd")
- (add-to-list 'comp_cmd (match-string 2)))
- ((string= (match-string 1) "check_cmd")
- (add-to-list 'check_cmd (match-string 2)))
- ((string= (match-string 1) "run_cmd")
- (add-to-list 'run_cmd (match-string 2)))
- ((string= (match-string 1) "debug_pre_cmd")
- (add-to-list 'debug_pre_cmd (match-string 2)))
- ((string= (match-string 1) "debug_post_cmd")
- (add-to-list 'debug_post_cmd (match-string 2)))
- (t
- ;; any other field in the file is just copied
- (set 'project (plist-put project (intern (match-string 1))
- (match-string 2))))))
- (forward-line 1))
-
- (if src_dir (set 'project (plist-put project 'src_dir
- (reverse src_dir))))
- (if obj_dir (set 'project (plist-put project 'obj_dir
- (reverse obj_dir))))
- (if casing (set 'project (plist-put project 'casing
- (reverse casing))))
- (if make_cmd (set 'project (plist-put project 'make_cmd
- (reverse make_cmd))))
- (if comp_cmd (set 'project (plist-put project 'comp_cmd
- (reverse comp_cmd))))
- (if check_cmd (set 'project (plist-put project 'check_cmd
- (reverse check_cmd))))
- (if run_cmd (set 'project (plist-put project 'run_cmd
- (reverse run_cmd))))
- (if debug_post_cmd (set 'project (plist-put project 'debug_post_cmd
- (reverse debug_post_cmd))))
- (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd
- (reverse debug_pre_cmd))))
-
- (set-buffer ada-buffer)
- )
+ "Read PRJ-FILE, set project properties in `ada-xref-project-files'."
+ (let ((project (ada-default-prj-properties)))
- ;; Else the file wasn't readable (probably the default project).
- ;; We initialize it with the current environment variables.
- ;; We need to add the startup directory in front so that
- ;; files locally redefined are properly found. We cannot
- ;; add ".", which varies too much depending on what the
- ;; current buffer is.
- (set 'project
- (plist-put project 'src_dir
- (append
- (list command-line-default-directory)
- (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
- (list "." default-directory))))
- (set 'project
- (plist-put project 'obj_dir
- (append
- (list command-line-default-directory)
- (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":")
- (list "." default-directory))))
- )
+ (setq prj-file (expand-file-name prj-file))
+ (if (string= (file-name-extension prj-file) "gpr")
+ (set 'project (ada-gnat-parse-gpr project prj-file))
+
+ (set '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)))
- ;; Delete the default project file from the list, if it is there.
- ;; Note that in that case, this default project is the only one in
- ;; the list
- (if (assoc nil ada-xref-project-files)
- (setq ada-xref-project-files nil))
+ (ada-xref-update-project-menu)
+ ))
- ;; Memorize the newly read project file
- (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)))
+(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))
- ;; Sets up the compilation-search-path so that Emacs is able to
- ;; go to the source of the errors in a compilation buffer
- (setq compilation-search-path (ada-xref-get-src-dir-field))
+ (widen)
+ (goto-char (point-min))
- ;; Set the casing exceptions file list
- (if casing
- (progn
- (setq ada-case-exception-file (reverse casing))
- (ada-case-read-exceptions)))
+ ;; process each line
+ (while (not (eobp))
- ;; Add the directories to the search path for ff-find-other-file
- ;; Do not add the '/' or '\' at the end
- (setq ada-search-directories-internal
- (append (mapcar 'directory-file-name compilation-search-path)
- ada-search-directories))
+ ;; 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")
+ (add-to-list 'ada_project_path
+ (expand-file-name
+ (substitute-in-file-name (match-string 2)))))
- (ada-xref-update-project-menu)
- )
+ ((string= (match-string 1) "build_dir")
+ (set 'project
+ (plist-put project 'build_dir
+ (file-name-as-directory (match-string 2)))))
- ;; No prj file ? => Setup default values
- ;; Note that nil means that all compilation modes will first look in the
- ;; current directory, and only then in the current file's directory. This
- ;; current file is assumed at this point to be in the common source
- ;; directory.
- (setq compilation-search-path (list nil default-directory))
+ ((string= (match-string 1) "casing")
+ (add-to-list 'casing
+ (expand-file-name (substitute-in-file-name (match-string 2)))))
+
+ ((string= (match-string 1) "check_cmd")
+ (add-to-list 'check_cmd (match-string 2)))
+
+ ((string= (match-string 1) "comp_cmd")
+ (add-to-list 'comp_cmd (match-string 2)))
+
+ ((string= (match-string 1) "debug_post_cmd")
+ (add-to-list 'debug_post_cmd (match-string 2)))
+
+ ((string= (match-string 1) "debug_pre_cmd")
+ (add-to-list 'debug_pre_cmd (match-string 2)))
+
+ ((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")
+ (add-to-list 'make_cmd (match-string 2)))
+
+ ((string= (match-string 1) "obj_dir")
+ (add-to-list 'obj_dir
+ (file-name-as-directory
+ (expand-file-name (match-string 2)))))
+
+ ((string= (match-string 1) "run_cmd")
+ (add-to-list 'run_cmd (match-string 2)))
+
+ ((string= (match-string 1) "src_dir")
+ (add-to-list 'src_dir
+ (file-name-as-directory
+ (expand-file-name (match-string 2)))))
+
+ (t
+ ;; any other field in the file is just copied
+ (set '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))
+ (set '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 (set 'project (plist-put project 'debug_post_cmd (reverse debug_post_cmd))))
+ (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd))))
+ (if casing (set 'project (plist-put project 'casing (reverse casing))))
+ (if check_cmd (set 'project (plist-put project 'check_cmd (reverse check_cmd))))
+ (if comp_cmd (set 'project (plist-put project 'comp_cmd (reverse comp_cmd))))
+ (if make_cmd (set 'project (plist-put project 'make_cmd (reverse make_cmd))))
+ (if run_cmd (set 'project (plist-put project 'run_cmd (reverse run_cmd))))
+
+ (if gpr_file
+ (progn
+ (set '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 (set 'project (plist-put project 'obj_dir (reverse obj_dir))))
+ (if src_dir (set '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.
(concat "'\"" (substring entity 1 -1) "\"'"))
entity))
(switches (ada-xref-get-project-field 'gnatfind_opt))
- (command (concat "gnat find " switches " "
+ ;; 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))
(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))))
+ (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))
(save-excursion
(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."
- (mapcar (lambda (x) (expand-file-name x root-dir)) 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.
(compile (ada-quote-cmd cmd))))
(defun ada-set-main-compile-application ()
- "Set main_unit and main project variables to current buffer, build main."
+ "Set main project variable to current buffer, build main."
(interactive)
(ada-require-project-file)
(let* ((file (buffer-file-name (current-buffer)))
(file-name-sans-extension file))
""))
(ada-xref-set-project-field 'main main)
- (ada-xref-set-project-field 'main_unit main)
(ada-compile-application))))
(defun ada-compile-current (&optional arg prj-field)
(process-environment (ada-set-environment))
(compilation-scroll-output t))
- (setq compilation-search-path (ada-xref-get-src-dir-field))
-
(unless cmd
(setq cmd '("") arg t))
)))
(defun ada-reread-prj-file (&optional filename)
- "Reread either the current project, or FILENAME if non-nil."
+ "Reread either the current project, or FILENAME if non-nil.
+If FILENAME is non-nil, set it as current project."
(interactive "P")
- (if filename
- (ada-parse-prj-file filename)
- (ada-parse-prj-file (ada-prj-find-prj-file)))
-
- ;; Reread the location of the standard runtime library
- (ada-initialize-runtime-library
- (or (ada-xref-get-project-field 'cross_prefix) ""))
- )
+ (if (not filename)
+ (setq filename ada-prj-default-project-file))
+ (ada-parse-prj-file filename)
+ (ada-select-prj-file filename))
;; ------ Private routines
(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)
- (setq krunch-buf (generate-new-buffer "*gkrunch*"))
+ (let ((krunch-buf (generate-new-buffer "*gkrunch*"))
+ (cross-prefix (plist-get plist 'cross_prefix)))
(save-excursion
(set-buffer krunch-buf)
;; send adaname to external process `gnatkr'.
;; behaviors depending on the version:
;; Up to 3.15: "AA.BB.CC" => aa-bb-cc
;; After: "AA.BB.CC" => aa-bb.cc
- (call-process "gnatkr" nil krunch-buf nil
+ (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
(defun ada-make-body-gnatstub (&optional interactive)
"Create an Ada package body in the current buffer.
-This function uses the `gnatstub' program to create the body.
-If INTERACTIVE is nil, kill the current buffer.
-This function typically is to be hooked into `ff-file-created-hook'."
+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)
- (save-some-buffers nil nil)
-
- ;; If the current buffer is the body (as is the case when calling this
- ;; function from ff-file-created-hook), then kill this temporary buffer
+ ;; 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 (this might not be the case
- ;; if for instance the user was asked for a project file)
+ ;; 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 gnatstub
- (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
+ ;; 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"))
- (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename))
- (buffer (get-buffer-create "*gnatstub*")))
+ (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*")))
(save-excursion
(set-buffer buffer)
(insert gnatstub-cmd)
(newline)
)
- ;; call gnatstub to create the body file
- (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
- (if (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (search-forward "command not found" nil t))
- (progn
- (message "gnatstub was not found -- using the basic algorithm")
- (sleep-for 2)
- (kill-buffer buffer)
- (ada-make-body))
+ (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
- ;; Else clean up the output
+ ;; clean up the output
- (if (file-exists-p output)
- (progn
- (find-file output)
- (kill-buffer buffer))
+ (if (file-exists-p output)
+ (progn
+ (find-file output)
+ (kill-buffer buffer))
- ;; display the error buffer
- (display-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.
'error-message
"File not found in src-dir (check project file): ")
-;; Initializes the cross references to the runtime library
-(ada-initialize-runtime-library "")
-
-;; Add these standard directories to the search path
-(set 'ada-search-directories-internal
- (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
- ada-search-directories))
-
(provide 'ada-xref)
;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e
HCoop / bpt / emacs.git / commitdiff