;;; for lookup and completion in Ada mode.
;;;
;;; If a file *.`adp' exists in the ada-file directory, then it is
;;; for lookup and completion in Ada mode.
;;;
;;; If a file *.`adp' exists in the ada-file directory, then it is
;;; time a cross-reference is asked for, and is not read later.
;;; You need Emacs >= 20.2 to run this package
;;; time a cross-reference is asked for, and is not read later.
;;; You need Emacs >= 20.2 to run this package
(defcustom ada-xref-create-ali nil
"*If non-nil, run gcc whenever the cross-references are not up-to-date.
(defcustom ada-xref-create-ali nil
"*If non-nil, run gcc whenever the cross-references are not up-to-date.
- "*Maximum number of characters for filenames created by gnatkr.
-Set to 0, if you don't use crunched filenames. This should be a string."
+ "*Maximum number of characters for filenames created by `gnatkr'.
+Set to 0, if you don't use crunched filenames. This should be a string."
- "*Arguments to pass to gnatfind when the location of the runtime is searched.
-Typical use is to pass --RTS=soft-floats on some systems that support it.
+ "*Arguments to pass to `gnatfind' to find location of the runtime.
+Typical use is to pass `--RTS=soft-floats' on some systems that support it.
- "Default switches to use for gnatfind.
-You should modify this variable, for instance to add -a, if you are working
+ "Default switches to use for `gnatfind'.
+You should modify this variable, for instance to add `-a', if you are working
(concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
" ${comp_opt}")
"*Default command to be used to compile a single file.
(concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
" ${comp_opt}")
"*Default command to be used to compile a single file.
syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
This has the same syntax as in the project file (with variable substitution)."
:type 'string :group 'ada)
This has the same syntax as in the project file (with variable substitution)."
:type 'string :group 'ada)
(defcustom ada-tight-gvd-integration nil
"*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
(defcustom ada-tight-gvd-integration nil
"*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
(defcustom ada-xref-search-with-egrep t
"*If non-nil, use egrep to find the possible declarations for an entity.
This alternate method is used when the exact location was not found in the
(defcustom ada-xref-search-with-egrep t
"*If non-nil, use egrep to find the possible declarations for an entity.
This alternate method is used when the exact location was not found in the
of sources, since it will search in all the files in your project."
:type 'boolean :group 'ada)
of sources, since it will search in all the files in your project."
:type 'boolean :group 'ada)
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
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
+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
- "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.")
+ "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.")
- "Separator to use when sending multiple commands to `compile' or
-`start-process'.
-cmdproxy.exe doesn't recognize multiple-line commands, so we have to use
+ "Separator to use between multiple commands to `compile' or `start-process'.
+`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use
;; -----------------------------------------------------------------------
(defun ada-quote-cmd (cmd)
;; -----------------------------------------------------------------------
(defun ada-quote-cmd (cmd)
(mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
(defun ada-initialize-runtime-library (cross-prefix)
(mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
(defun ada-initialize-runtime-library (cross-prefix)
- "Initializes the variables for the runtime library location.
-CROSS-PREFIX is the prefix to use for the gnatls command"
+ "Initialize the variables for the runtime library location.
+CROSS-PREFIX is the prefix to use for the gnatls command."
;; 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))))))
;; 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))))))
(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
(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
a project file unless the user has already loaded one."
(interactive "fProject file:")
(if (or (not keep-existing)
a project file unless the user has already loaded one."
(interactive "fProject file:")
(if (or (not keep-existing)
If NO-USER-QUESTION is non-nil, use a default file if not project file was
found, and do not ask the user.
If the buffer is not an Ada buffer, associate it with the default project
If NO-USER-QUESTION is non-nil, use a default file if not project file was
found, and do not ask the user.
If the buffer is not an Ada buffer, associate it with the default project
(ada-xref-set-default-prj-values 'project (current-buffer))
;; Do not use find-file below, since we don't want to show this
(ada-xref-set-default-prj-values 'project (current-buffer))
;; Do not use find-file below, since we don't want to show this
;; find-file anyway, since the speedbar frame is special and does not
;; allow the selection of a file in it.
;; find-file anyway, since the speedbar frame is special and does not
;; allow the selection of a file in it.
;; 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
;; 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
;; No prj file ? => Setup default values
;; Note that nil means that all compilation modes will first look in the
;; No prj file ? => Setup default values
;; Note that nil means that all compilation modes will first look in the
;; current file is assumed at this point to be in the common source
;; directory.
(setq compilation-search-path (list nil default-directory))
;; current file is assumed at this point to be in the common source
;; directory.
(setq compilation-search-path (list nil default-directory))
(defun ada-find-references (&optional pos arg local-only)
"Find all references to the entity under POS.
Calls gnatfind to find the references.
(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 t, the contents of the old *gnatfind* buffer is preserved.
-if LOCAL-ONLY is t, only the declarations in the current file are returned."
- (interactive "d
-P")
+If ARG is t, the contents of the old *gnatfind* buffer is preserved.
+If LOCAL-ONLY is t, only the declarations in the current file are returned."
+ (interactive "d\nP")
-Calls gnatfind to find the references.
-if ARG is t, the contents of the old *gnatfind* buffer is preserved."
- (interactive "d
-P")
+Calls `gnatfind' to find the references.
+If ARG is t, the contents of the old *gnatfind* buffer is preserved."
+ (interactive "d\nP")
(ada-find-references pos arg t))
(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.
(ada-find-references pos arg t))
(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 APPEND is t, then the output of the command will be append to the existing
-buffer *gnatfind* if it exists."
+If APPEND is t, then append the output of the command to the existing
+buffer `*gnatfind*', if there is one."
;; around operators, so that they are correctly handled and can be
;; processed (gnatfind \"+\":...).
(let* ((quote-entity
;; around operators, so that they are correctly handled and can be
;; processed (gnatfind \"+\":...).
(let* ((quote-entity
;; ----- Identifier Completion --------------------------------------------
(defun ada-complete-identifier (pos)
"Tries to complete the identifier around POS.
;; ----- Identifier Completion --------------------------------------------
(defun ada-complete-identifier (pos)
"Tries to complete the identifier around POS.
;; 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)))
;; 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)))
;; 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)
;; 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)
(defun ada-get-absolute-dir-list (dir-list root-dir)
"Returns the list of absolute directories found in dir-list.
(defun ada-get-absolute-dir-list (dir-list root-dir)
"Returns the list of absolute directories found in dir-list.
- "Return the new value for process-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"))
It modifies the source path and object path with the values found in the
project file."
(let ((include (getenv "ADA_INCLUDE_PATH"))
If ARG is not nil, ask for user confirmation."
(interactive "P")
(ada-require-project-file)
If ARG is not nil, ask for user confirmation."
(interactive "P")
(ada-require-project-file)
(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
;; Insert newlines so as to separate the name of the commands to run
(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
;; Insert newlines so as to separate the name of the commands to run
;; which gets confused by newline characters.
(if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
;; which gets confused by newline characters.
(if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
;; Insert newlines so as to separate the name of the commands to run
(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
;; Insert newlines so as to separate the name of the commands to run
;; which gets confused by newline characters.
(if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
;; which gets confused by newline characters.
(if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
;; 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
;; 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
;; is going to have some relevant information.
(if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
(string-match "--tty" cmd))
;; is going to have some relevant information.
(if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
(string-match "--tty" cmd))
"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
"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"
+the cross-reference information. Note that the ali file can then be deduced by
+replacing the file extension with `.ali'."
;; process, or the ALI file would still not be available.
;; Unfortunately, the underlying `compile' command that we use is
;; asynchronous.
;; process, or the ALI file would still not be available.
;; Unfortunately, the underlying `compile' command that we use is
;; asynchronous.
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)
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)
Adds src_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-src-dir-field)))
Adds src_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-src-dir-field)))
;; and look for this file
;; 2- If this file is found:
;; grep the "^U" lines, and make sure we are not reading the
;; and look for this file
;; 2- If this file is found:
;; grep the "^U" lines, and make sure we are not reading the
;; 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 subtituing the extension
;; 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 subtituing 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
;; 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
;; 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
;; 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
- ;; recompile only if the user asked for this. and search the ali
- ;; filename again. We avoid a possible infinite recursion by
+ ;; Recompile only if the user asked for this, and search the ali
+ ;; filename again. We avoid a possible infinite recursion by
(defun ada-get-ada-file-name (file original-file)
"Create the complete file name (+directory) for FILE.
(defun ada-get-ada-file-name (file original-file)
"Create the complete file name (+directory) for FILE.
(set 'declaration-found nil))))
;; Still no success ! The ali file must be too old, and we need to
(set 'declaration-found nil))))
;; Still no success ! The ali file must be too old, and we need to
;; if the user does not want us to automatically recompile files
;; automatically
(unless declaration-found
(if (ada-xref-find-in-modified-ali identlist)
(set 'declaration-found t)
;; if the user does not want us to automatically recompile files
;; automatically
(unless declaration-found
(if (ada-xref-find-in-modified-ali identlist)
(set 'declaration-found t)
;; commands instead of one in case there is no .ali file in one
;; of the directory and the shell stops because of that.
;; commands instead of one in case there is no .ali file in one
;; of the directory and the shell stops because of that.
(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
(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
If OTHER-FRAME is non-nil, creates a new frame to show the file."
(let (declaration-buffer)
If OTHER-FRAME is non-nil, creates a new frame to show the file."
(let (declaration-buffer)
;; this might have already been done if we have been called from the hook,
;; but this is not an expensive call)
(ada-require-project-file)
;; this might have already been done if we have been called from the hook,
;; but this is not an expensive call)
(ada-require-project-file)
;; Use gvd or ddd as the default debugger if it was found
;; On windows, do not use the --tty switch for GVD, since this is
;; Use gvd or ddd as the default debugger if it was found
;; On windows, do not use the --tty switch for GVD, since this is
-;; not supported. Actually, we do not use this on Unix either, since otherwise
-;; there is no console window left in GVD, and people have to use the
-;; Emacs one.
+;; not supported. Actually, we do not use this on Unix either,
+;; since otherwise there is no console window left in GVD,
+;; and people have to use the Emacs one.
;; This must be done before initializing the Ada menu.
(if (ada-find-file-in-dir "gvd" exec-path)
(set 'ada-prj-default-debugger "gvd ")
;; This must be done before initializing the Ada menu.
(if (ada-find-file-in-dir "gvd" exec-path)
(set 'ada-prj-default-debugger "gvd ")