-;;; ada-xref.el --- for lookup and completion in Ada mode
+;; ada-xref.el --- for lookup and completion in Ada mode
-;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;; Rolf Ebert <ebert@inf.enst.fr>
;; Emmanuel Briot <briot@gnat.com>
-;; Maintainer: Emmanuel Briot <briot@gnat.com>
-;; Ada Core Technologies's version: Revision: 1.181
+;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: languages ada xref
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; This Package provides a set of functions to use the output of the
;;; for lookup and completion in Ada mode.
;;;
;;; If a file *.`adp' exists in the ada-file directory, then it is
-;;; read for configuration informations. It is read only the first
+;;; read for configuration informations. It is read only the first
;;; time a cross-reference is asked for, and is not read later.
;;; You need Emacs >= 20.2 to run this package
+
+;;; History:
+;;
+
;;; Code:
;; ----- Requirements -----------------------------------------------------
(require 'find-file)
(require 'ada-mode)
-;; ------ Use variables
+;; ------ 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."
(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 will never run gcc."
+If nil, the cross-reference mode never runs gcc."
:type 'boolean :group 'ada)
(defcustom ada-xref-confirm-compile nil
- "*If non-nil, always ask for user confirmation before compiling or running
-the application."
+ "*Non-nil means 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."
+ "*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-gnatls-args '("-v")
- "*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.
-You can also add -I- if you do not want the current directory to be included.
+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,
+current directory. This only has an impact if you are not using project files,
but only ADA_INCLUDE_PATH."
:type '(repeat string) :group 'ada)
:type 'string :group 'ada)
(defcustom ada-prj-default-gnatmake-opt "-g"
- "Default options for gnatmake."
+ "Default options for `gnatmake'."
: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
+ "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
+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 add the filename at the end of this command. This is the same
-syntax as in the project 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. We recommend either `gdb',
-`gdb --emacs_gdbtk' or `ddd --tty -fullname'."
+ "*Default name of the debugger."
:type 'string :group 'ada)
(defcustom ada-prj-default-make-cmd
(concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} "
- "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_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 project file to use for every Ada file.
-Emacs will not try to use the standard algorithm to find the project file if
-this string is not empty."
+ "*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}"
- "*List of the options to pass to gnatsub to generate the body of a package.
+ "*List of the 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)
:type 'boolean :group 'ada)
(defconst is-windows (memq system-type (quote (windows-nt)))
- "True if we are running on windows NT or windows 95.")
+ "True if we are running on Windows NT or Windows 95.")
(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.")
+If GVD is not the debugger used, nothing happens."
+ :type 'boolean :group 'ada)
(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
-information provided by GNAT. However, it might be expensive if you have a lot
+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)
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
file.")
(defvar ada-last-prj-file ""
"Name of the last project file entered by the user.")
-(defvar ada-check-switch "-gnats"
- "Switch added to the command line to check the current file.")
-
-(defconst ada-project-file-extension ".adp"
+(defconst ada-prj-file-extension ".adp"
"The extension used for project files.")
(defvar ada-xref-runtime-library-specs-path '()
(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.")
+ "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 is-windows " && " "\n")
- "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
\"&&\" for now.")
(defconst ada-xref-pos-ring-max 16
"Regexp to match for operators.")
(defvar ada-xref-project-files '()
- "Associative list of project files.
-It has the following format:
-\((project_name . value) (project_name . value) ...)
-As always, the values of the project file are defined through properties.")
+ "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-xref-set-default-prj-values 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 -------------------------------------------
(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
(defsubst ada-get-ali-buffer (file)
- "Reads the ali file into a new buffer, and returns this buffer's name"
+ "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)
- "Duplicates all \\ characters in CMD so that it can be passed to `compile'"
+ "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.
+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))
+
(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."
(save-excursion
(setq ada-xref-runtime-library-specs-path '()
ada-xref-runtime-library-ali-path '())
;; Even if we get an error, delete the *gnatls* buffer
(unwind-protect
(progn
- (apply 'call-process (concat cross-prefix "gnatls")
- (append '(nil t nil) ada-gnatls-args))
+ (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
(defun ada-treat-cmd-string (cmd-string)
"Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
-The project file must have been loaded first.
-As a special case, ${current} is replaced with the name of the currently
-edited file, minus extension but with directory, and ${full_current} is
+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)
;; Check if there is an environment variable with the same name
(if (null value)
(if (not (setq value (getenv name)))
- (message (concat "No environment variable " name " found"))))
+ (message "%s" (concat "No environment variable " name " found"))))
(cond
((null value)
(set-buffer ada-buffer)
(set 'plist
- ;; Try hard to find a default value for filename, so that the user
- ;; can edit his project file even if the current buffer is not an
- ;; Ada file or not even associated with a file
+ ;; 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
"")
'cross_prefix ""
'remote_machine ""
- 'comp_cmd (list (concat ada-cd-command " ${build_dir}")
- ada-prj-default-comp-cmd)
- 'check_cmd (list (concat ada-prj-default-comp-cmd " "
- ada-check-switch))
- 'make_cmd (list (concat ada-cd-command " ${build_dir}")
- ada-prj-default-make-cmd)
- 'run_cmd (list (concat ada-cd-command " ${build_dir}")
- (concat "${main}"
- (if is-windows ".exe")))
- 'debug_pre_cmd (list (concat ada-cd-command
- " ${build_dir}"))
+ '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
- (if is-windows " ${main}.exe"
- " ${main}"))
+ " ${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.
-The project file must have been loaded first.
-A default value is returned if the file was not found.
+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
)
))
-
(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."
(defun ada-xref-update-project-menu ()
"Update the menu Ada->Project, with the list of available project files."
- (let (submenu)
-
- ;; Create the standard items
- (set 'submenu (list (cons 'Load (cons "Load..."
- 'ada-set-default-project-file))
- (cons 'New (cons "New..." 'ada-prj-new))
- (cons 'Edit (cons "Edit..." 'ada-prj-edit))
- (cons 'sep (cons "---" nil))))
-
- ;; Add the new items
- (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))))
- (set 'submenu
- (append submenu
- (list (cons (intern name)
- (list
- 'menu-item
- (if (string= (file-name-extension name)
- ada-project-file-extension)
- (file-name-sans-extension
- (file-name-nondirectory name))
- (file-name-nondirectory name))
- command
- :button (cons
- :toggle
- (equal ada-prj-default-project-file
- (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)))
-
- (if (not (featurep 'xemacs))
- (if (lookup-key ada-mode-map [menu-bar Ada Project])
- (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])
- submenu)))
- ))
+ ;; 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 new items
+ ,@(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))))
+ (vector
+ (if (string= (file-name-extension name)
+ ada-prj-file-extension)
+ (file-name-sans-extension
+ (file-name-nondirectory name))
+ (file-name-nondirectory name))
+ command
+ :button (cons
+ :toggle
+ (equal ada-prj-default-project-file
+ (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)))
;;-------------------------------------------------------------
"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
(let (list
(dirs (ada-xref-get-src-dir-field)))
;;;###autoload
(defun ada-find-file (filename)
- "Open a file anywhere in the source path.
+ "Open FILENAME, from anywhere in the source path.
Completion is available."
(interactive
(list (completing-read "File: " 'ada-do-file-completion)))
(goto-char (car pos)))))
(defun ada-convert-file-name (name)
- "Converts from NAME to a name that can be used by the compilation commands.
+ "Convert from NAME to a name that can be used by the compilation commands.
This is overriden on VMS to convert from VMS filenames to Unix filenames."
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
+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."
(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
-file. If none is set, return nil."
+file. If none is set, return nil."
(let (selected)
(let* ((current-file (or file (buffer-file-name)))
(first-choice (concat
(file-name-sans-extension current-file)
- ada-project-file-extension))
+ ada-prj-file-extension))
(dir (file-name-directory current-file))
;; on Emacs 20.2, directory-files does not work if
(prj-files (directory-files
dir t
(concat ".*" (regexp-quote
- ada-project-file-extension) "$")))
+ ada-prj-file-extension) "$")))
(choice nil))
(cond
(not (integerp choice))
(< choice 1)
(> choice (length prj-files)))
- (setq choice (string-to-int
+ (setq choice (string-to-number
(read-from-minibuffer "Enter No. of your choice: "))))
(set 'selected (nth (1- choice) prj-files))))
(defun ada-parse-prj-file (prj-file)
- "Reads and parses the PRJ-FILE file if it was found.
-The current buffer should be the ada-file buffer."
+ "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)))
+ (ada-buffer (current-buffer)))
(setq prj-file (expand-file-name prj-file))
;; Set the project file as the active one.
(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
+ ;; 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.
(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) "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))
(reverse check_cmd))))
(if run_cmd (set 'project (plist-put project 'run_cmd
(reverse run_cmd))))
- (set 'project (plist-put project 'debug_post_cmd
- (reverse debug_post_cmd)))
- (set 'project (plist-put project 'debug_pre_cmd
- (reverse debug_pre_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))))
;; Kill the project buffer
(kill-buffer nil)
;; 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.
+ ;; 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)
+ (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)
+ (list command-line-default-directory)
(split-string (or (getenv "ADA_OBJECTS_PATH") "") ":")
(list "." default-directory))))
)
;; go to the source of the errors in a compilation buffer
(setq compilation-search-path (ada-xref-get-src-dir-field))
- ;; Set the casing exceptions file list
- (if casing
- (progn
- (setq ada-case-exception-file (reverse casing))
- (ada-case-read-exceptions)))
+ ;; Set the casing exceptions file list
+ (if casing
+ (progn
+ (setq ada-case-exception-file (reverse casing))
+ (ada-case-read-exceptions)))
;; Add the directories to the search path for ff-find-other-file
;; Do not add the '/' or '\' at the end
;; 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 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))
(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")
(ada-require-project-file)
(let* ((identlist (ada-read-identifier pos))
- (alifile (ada-get-ali-file-name (ada-file-of identlist)))
+ (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)
+ (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)))
+ (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 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.
-If LOCAL-ONLY is t, then only the references in file will be listed, which
+If LOCAL-ONLY is t, then list only the references in FILE, which
is much faster.
-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."
(interactive "sEntity name: ")
(ada-require-project-file)
- ;; Prepare the gnatfind command. Note that we must protect the quotes
+ ;; 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
(switches (ada-xref-get-project-field 'gnatfind_opt))
(command (concat "gnat find " switches " "
quote-entity
- (if file (concat ":" (file-name-nondirectory file)))
- (if line (concat ":" line))
- (if column (concat ":" column))
+ (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 (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 "*gnatfind*"))
(save-excursion
(set-buffer "*gnatfind*")
(setq old-contents (buffer-string))))
- (compile-internal command "No more references" "gnatfind")
+ (let ((compilation-error "reference"))
+ (compilation-start command))
;; Hide the "Compilation" menu
(save-excursion
;; ----- Identifier Completion --------------------------------------------
(defun ada-complete-identifier (pos)
- "Tries to complete the identifier around POS.
-The feature is only available if the files where compiled not using the -gnatx
-option."
+ "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))
+ (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)))
(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")
;; 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 nil
+ (condition-case err
(ada-find-in-ali identlist other-frame)
+ ;; File not found: print explicit error message
+ (error-file-not-found
+ (message (concat (error-message-string err)
+ (nthcdr 1 err))))
+
(error
(let ((ali-file (ada-get-ali-file-name (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)))
- (message "No cross-reference found. It might be a predefined entity.")
+ (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.")
+ (message "Cross-referencing information is not up-to-date; please recompile.")
)))))))
-(defun ada-goto-declaration-other-frame (pos &optional other-frame)
+(defun ada-goto-declaration-other-frame (pos)
"Display the declaration of the identifier around POS.
The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
(interactive "d")
command))))
(defun ada-get-absolute-dir-list (dir-list root-dir)
- "Returns the list of absolute directories found in dir-list.
-If a directory is a relative directory, the value of ROOT-DIR is added in
-front."
+ "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))
(defun ada-set-environment ()
- "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"))
process-environment))))
(defun ada-compile-application (&optional arg)
- "Compiles the application, using the command found in the project file.
+ "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)
(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,
+ ;; 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")))
(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-check-current (&optional arg)
(defun ada-run-application (&optional arg)
"Run the application.
-if ARG is not-nil, asks for user confirmation."
+if ARG is not-nil, ask for user confirmation."
(interactive)
(ada-require-project-file)
;; Guess the command if it wasn't specified
(if (not command)
- (set 'command (list (file-name-sans-extension (buffer-name)))))
+ (set 'command (list (file-name-sans-extension (buffer-name)))))
;; Modify the command to run remotely
(setq command (ada-remote (mapconcat 'identity command
(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.
-If ARG is non-nil, ask the user to confirm the command."
+project file."
(interactive "P")
(let ((buffer (current-buffer))
cmd pre-cmd post-cmd)
;; 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
+ ;; chance to fully manage it. Then it works fine with Enlightenment
;; as well
(let ((frame (make-frame '((visibility . nil)))))
(set 'cmd (concat
(if (or arg ada-xref-confirm-compile)
(set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
- (let ((old-comint-exec (symbol-function 'comint-exec))
- comint-exec
- in-post-mode
- gud-gdb-massage-args)
+ (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))
(set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
(set 'post-cmd (mapconcat 'identity post-cmd "\n"))
(if post-cmd
- (set 'post-cmd (concat post-cmd "\n")))
+ (set 'post-cmd (concat post-cmd "\n")))
;; Temporarily replaces the definition of `comint-exec' so that we
;; can execute commands before running gdb.
- (make-local-variable 'comint-exec)
+ ;; FIXME: This is evil and not temporary !!! -stef
(fset 'comint-exec
`(lambda (buffer name command startfile switches)
(let (compilation-buffer-name-function)
;; Move to the end of the debugger buffer, so that it is automatically
;; scrolled from then on.
- (end-of-buffer)
+ (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
+ ;; 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))
(switch-to-buffer buffer)
)))
-
(defun ada-reread-prj-file (&optional filename)
- "Forces Emacs to read either FILENAME or the project file associated
-with the current buffer.
-Otherwise, this file is only read once, and never read again.
-Since the information in the project file is shared between all buffers, this
-automatically modifies the setup for all the Ada buffer that use this file."
+ "Reread either the current project, or FILENAME if non-nil."
(interactive "P")
(if filename
(ada-parse-prj-file filename)
"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'."
;; kill old buffer
(if (and ali-file-name
- (get-file-buffer ali-file-name))
+ (get-file-buffer ali-file-name))
(kill-buffer (get-file-buffer ali-file-name)))
(let* ((name (ada-convert-file-name file))
(body-name (or (ada-get-body-name name) name)))
- ;; Always recompile the body when we can. We thus temporarily switch to a
+ ;; 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))
(set-buffer body-visible)
(find-file body-name))
- ;; Execute the compilation. Note that we must wait for the end of the
+ ;; 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.
found))
(defun ada-find-ali-file-in-dir (file)
- "Find an .ali file in obj_dir. The current buffer must be the Ada 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 a source file in src_dir. The current buffer must be the Ada file.
-Adds src_dir in front of the search path to conform to gnatmake's behavior,
-and the standard runtime location at the end."
+ "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)
;; 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.
+ ;; .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 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
- ;; ali file for the parent unit. If we found an ali file, we check that
+ ;; 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
+ ;; the 'D' lines. This is done repeatedly, in case the direct parent is
;; also a separate.
(save-excursion
(set-buffer (get-file-buffer file))
(let ((short-ali-file-name
- (concat (file-name-sans-extension (file-name-nondirectory file))
- ".ali"))
- ali-file-name
+ (concat (file-name-sans-extension (file-name-nondirectory 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
+ ;; 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"))
;; 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
+ ;; 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
(concat (file-name-sans-extension (ada-xref-current file))
".ali"))
- (error "Ali file not found. Recompile your file"))
+ (error "`.ali' file not found; recompile your source file"))
;; same if the .ali file is too old and we must recompile it
(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
+The original file (where the user was) is ORIGINAL-FILE. Search in project
file for possible paths."
(save-excursion
;; return the absolute file name
(let ((filename (ada-find-src-file-in-dir file)))
(if filename
- (expand-file-name filename)
- (error (concat
- (file-name-nondirectory file)
- " not found in src_dir. Please check your project file")))
-
+ (expand-file-name filename)
+ (signal 'error-file-not-found (file-name-nondirectory file)))
)))
(defun ada-find-file-number-in-ali (file)
- "Returns the file number for FILE in the associated ali file."
+ "Return the file number for FILE in the associated ali file."
(set-buffer (ada-get-ali-buffer file))
(goto-char (point-min))
(count-lines begin (point))))
(defun ada-read-identifier (pos)
- "Returns the identlist around POS and switch to the .ali buffer.
+ "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',..."
;; Just in front of a string => we could have an operator declaration,
;; as in "+", "-", ..
(if (= (char-after) ?\")
- (forward-char 1))
+ (forward-char 1))
;; if looking at an operator
;; This is only true if:
(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))
- (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
+ (progn
+ (if (and (= (char-before) ?\")
+ (= (char-after (+ (length (match-string 0)) (point))) ?\"))
+ (forward-char -1))
+ (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
(if (ada-in-string-p)
- (error "Inside string or character constant"))
+ (error "Inside string or character constant"))
(if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
- (error "No cross-reference available for reserved keyword"))
+ (error "No cross-reference available for reserved keyword"))
(if (looking-at "[a-zA-Z0-9_]+")
- (set 'identifier (match-string 0))
- (error "No identifier around")))
+ (set 'identifier (match-string 0))
+ (error "No identifier around")))
;; Build the identlist
(set 'identlist (ada-make-identlist))
))
(defun ada-get-all-references (identlist)
- "Completes and returns IDENTLIST with the information extracted
-from the ali file (definition file and places where it is referenced)."
+ "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)
(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))))
- (set 'declaration-found
+ (let ((bound (save-excursion (re-search-forward "^X " nil t))))
+ (set 'declaration-found
(re-search-forward
(concat "^" (ada-line-of identlist)
"." (ada-column-of identlist)
"[ *]" (ada-name-of identlist)
- "[{\(<= ]?\\(.*\\)$") bound t))
+ "[{\[\(<= ]?\\(.*\\)$") bound t))
(if declaration-found
(ada-set-on-declaration identlist t))
))
(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
+ ;; 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\\.\\)*\\<"
+ "[ <{=\(\[]\\(.\\|\n\\.\\)*\\<"
(ada-line-of identlist)
"[^0-9]"
(ada-column-of identlist) "\\>")
;; or the source file has been modified since the ali file was
;; created
(set 'declaration-found nil)
- )
+ )
)
;; Last check to be completly sure we have found the correct line (the
(beginning-of-line)
;; while we have a continuation line, go up one line
(while (looking-at "^\\.")
- (previous-line 1))
+ (previous-line 1)
+ (beginning-of-line))
(unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
- (ada-name-of identlist) "[ <{=\(]"))
+ (ada-name-of identlist) "[ <{=\(\[]"))
(set '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
+ ;; 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)
(set 'declaration-found t)
- ;; no more idea to find the declaration. Give up
+ ;; No more idea to find the declaration. Give up
(progn
(kill-buffer ali-buffer)
(error (concat "No declaration of " (ada-name-of identlist)
;; information available
(beginning-of-line)
(if declaration-found
- (let ((current-line (buffer-substring
+ (let ((current-line (buffer-substring
(point) (save-excursion (end-of-line) (point)))))
- (save-excursion
- (next-line 1)
- (beginning-of-line)
- (while (looking-at "^\\.\\(.*\\)")
- (set 'current-line (concat current-line (match-string 1)))
- (next-line 1))
- )
+ (save-excursion
+ (next-line 1)
+ (beginning-of-line)
+ (while (looking-at "^\\.\\(.*\\)")
+ (set 'current-line (concat current-line (match-string 1)))
+ (next-line 1))
+ )
(if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
(ada-file-of identlist)))
;; Else clean up the ali file
+ (error-file-not-found
+ (signal (car err) (cdr err)))
(error
(kill-buffer ali-buffer)
(error (error-message-string err)))
(unless (= (string-to-char (ada-name-of identlist)) ?\")
(progn
- (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
+ (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
(my-regexp (concat "[ *]"
(regexp-quote (ada-name-of identlist)) " "))
(line-ada "--")
(choice 0)
(ali-buffer (current-buffer)))
- (goto-char (point-max))
- (while (re-search-backward my-regexp nil t)
- (save-excursion
- (set '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)
+ (goto-char (point-max))
+ (while (re-search-backward my-regexp nil t)
+ (save-excursion
+ (set '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)
(add-to-list
'declist (list line-ali (match-string 1) line-ada col-ada))
- )
- )
- )
-
- ;; how many possible declarations have we found ?
- (setq len (length declist))
- (cond
- ;; none => error
- ((= len 0)
- (kill-buffer (current-buffer))
- (error (concat "No declaration of "
- (ada-name-of identlist)
- " recorded in .ali file")))
-
- ;; one => should be the right one
- ((= len 1)
- (goto-line (caar declist)))
-
- ;; more than one => display choice list
- (t
+ )
+ )
+ )
+
+ ;; how many possible declarations have we found ?
+ (setq len (length declist))
+ (cond
+ ;; none => error
+ ((= len 0)
+ (kill-buffer (current-buffer))
+ (error (concat "No declaration of "
+ (ada-name-of identlist)
+ " recorded in .ali file")))
+
+ ;; one => should be the right one
+ ((= len 1)
+ (goto-line (caar declist)))
+
+ ;; more than one => display choice list
+ (t
(save-window-excursion
(with-output-to-temp-buffer "*choice list*"
(let ((counter 0))
(while (< counter len)
(princ (format " %2d) %-21s %4s %4s\n"
- (1+ counter)
+ (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))
- ))
+ (nth 2 (nth counter declist))
+ (nth 3 (nth counter declist))
+ ))
(setq counter (1+ counter))
) ; end of while
) ; end of let
(< choice 1)
(> choice len))
(setq choice
- (string-to-int
+ (string-to-number
(read-from-minibuffer "Enter No. of your choice: "))))
)
(set-buffer ali-buffer)
- (goto-line (car (nth (1- choice) declist)))
- ))))))
+ (goto-line (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,
+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)
;; 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)
+ (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line)
(set 'locations (list (list (match-string 1 ali-line) ;; line
(match-string 2 ali-line) ;; column
(ada-declare-file-of identlist))))
start (match-end 3))
;; it there was a file number in the same line
- (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?"
+ ;; 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)))
This works well when one is using an external librarie and wants
to find the declaration and documentation of the subprograms one is
is using."
-
+;; FIXME: what does this function do?
(let (list
(dirs (ada-xref-get-obj-dir-field))
(regexp (concat "[ *]" (ada-name-of identlist)))
(save-excursion
- ;; Do the grep in all the directories. We do multiple shell
+ ;; 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.
(set-buffer (get-buffer-create "*grep*"))
(while dirs
(insert (shell-command-to-string
- (concat "egrep -i -h '^X|" regexp "( |$)' "
- (file-name-as-directory (car dirs)) "*.ali")))
+ (concat
+ "grep -E -i -h "
+ (shell-quote-argument (concat "^X|" regexp "( |$)"))
+ " "
+ (shell-quote-argument (file-name-as-directory (car dirs)))
+ "*.ali")))
(set 'dirs (cdr dirs)))
;; Now parse the output
(< choice 1)
(> choice (length list)))
(setq choice
- (string-to-int
+ (string-to-number
(read-from-minibuffer "Enter No. of your choice: "))))
)
(set 'choice (1- choice))
(string-to-number (nth 2 (nth choice list)))
identlist
other-frame)
- (error (concat (car (nth choice list)) " not found in src_dir")))
+ (signal 'error-file-not-found (car (nth choice list))))
(message "This is only a (good) guess at the cross-reference.")
))))
(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.
+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)
- (set 'declaration-buffer (find-file-noselect file))
- (set-buffer declaration-buffer)
- (switch-to-buffer-other-window declaration-buffer)
- )
+ (if other-frame
+ (find-file-other-frame file)
+ (set 'declaration-buffer (find-file-noselect file))
+ (set-buffer declaration-buffer)
+ (switch-to-buffer-other-window declaration-buffer)
+ )
(find-file file)
)
(defun ada-xref-search-nearest (name)
- "Searches for NAME nearest to the position recorded in the Xref file.
-It returns the position of the declaration in the buffer or nil if not found."
+ "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))
+ (newpos nil)
+ (diff nil))
(goto-char (point-max))
;; 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)
+ (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))
+ (progn
+ (message "ATTENTION: this declaration is only a (good) guess ...")
+ (goto-char newpos))
nil)))
(ada-require-project-file)
(let ((buffer (ada-get-ali-buffer (buffer-file-name)))
- (unit-name nil)
- (body-name nil)
- (ali-name nil))
+ (unit-name nil)
+ (body-name nil)
+ (ali-name nil))
(save-excursion
(set-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))
- )
+ (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]+\\)"))
+ "%s[ \t]+\\([^ \t]+\\)[ \t]+"
+ "\\([^ \t\n]+\\)"))
(setq body-name (match-string 1))
(setq ali-name (match-string 2))
(kill-buffer buffer)
(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))
- )
- )
+ (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)
(save-excursion
(set-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 "gnatkr" nil krunch-buf nil
- adaname ada-krunch-args)
+ (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))))
+ (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 ()
+(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.
This function typically is to be hooked into `ff-file-created-hooks'."
- (interactive)
+ (interactive "p")
(save-some-buffers nil nil)
;; If the current buffer is the body (as is the case when calling this
;; function from ff-file-created-hooks), then kill this temporary buffer
- (unless (interactive-p)
+ (unless interactive
(progn
(set-buffer-modified-p nil)
(kill-buffer (current-buffer))))
(unless (buffer-file-name (car (buffer-list)))
(set-buffer (cadr (buffer-list))))
- ;; Make sure we have a project file (for parameters to gnatstub). Note that
+ ;; Make sure we have a project file (for parameters to gnatstub). Note that
;; 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)
;; Call the external process gnatstub
(let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
- (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*")))
+ (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*")))
(save-excursion
(set-buffer buffer)
(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))
+ (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))
;; Else clean up the output
(if (file-exists-p output)
- (progn
- (find-file output)
- (kill-buffer buffer))
+ (progn
+ (find-file output)
+ (kill-buffer buffer))
- ;; display the error buffer
- (display-buffer buffer)
- )
+ ;; display the error buffer
+ (display-buffer buffer)
+ )
)))
(defun ada-xref-initialize ()
(ada-xref-update-project-menu)
)
-
;; ----- Add to ada-mode-hook ---------------------------------------------
-;; 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.
;; This must be done before initializing the Ada menu.
-(if (ada-find-file-in-dir "gvd" exec-path)
- (set 'ada-prj-default-debugger "gvd ")
- (if (ada-find-file-in-dir "gvd.exe" exec-path)
- (set 'ada-prj-default-debugger "gvd ")
- (if (ada-find-file-in-dir "ddd" exec-path)
- (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
-
(add-hook 'ada-mode-hook 'ada-xref-initialize)
+;; Define a new error type
+(put 'error-file-not-found
+ 'error-conditions
+ '(error ada-mode-errors error-file-not-found))
+(put 'error-file-not-found
+ 'error-message
+ "File not found in src-dir (check project file): ")
+
;; Initializes the cross references to the runtime library
(ada-initialize-runtime-library "")
(provide 'ada-xref)
+;;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e
;;; ada-xref.el ends here