(c-lang-defvar-init-form-tail): This is actually not a constant.
[bpt/emacs.git] / lisp / progmodes / ada-xref.el
CommitLineData
3afbc435 1;;; ada-xref.el --- for lookup and completion in Ada mode
797aab3c 2
c94ca9e0 3;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002, 2003
4884c50b 4;; Free Software Foundation, Inc.
797aab3c
GM
5
6;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
7;; Rolf Ebert <ebert@inf.enst.fr>
8;; Emmanuel Briot <briot@gnat.com>
9;; Maintainer: Emmanuel Briot <briot@gnat.com>
c94ca9e0 10;; Ada Core Technologies's version: Revision: 1.181
797aab3c
GM
11;; Keywords: languages ada xref
12
874d7995 13;; This file is part of GNU Emacs.
797aab3c 14
2be7dabc 15;; GNU Emacs is free software; you can redistribute it and/or modify
797aab3c
GM
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation; either version 2, or (at your option)
18;; any later version.
19
2be7dabc 20;; GNU Emacs is distributed in the hope that it will be useful,
797aab3c
GM
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
2be7dabc
GM
26;; along with GNU Emacs; see the file COPYING. If not, write to the
27;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28;; Boston, MA 02111-1307, USA.
797aab3c
GM
29
30;;; Commentary:
31;;; This Package provides a set of functions to use the output of the
32;;; cross reference capabilities of the GNAT Ada compiler
33;;; for lookup and completion in Ada mode.
34;;;
797aab3c
GM
35;;; If a file *.`adp' exists in the ada-file directory, then it is
36;;; read for configuration informations. It is read only the first
37;;; time a cross-reference is asked for, and is not read later.
38
39;;; You need Emacs >= 20.2 to run this package
40
3afbc435
PJ
41;;; Code:
42
797aab3c
GM
43;; ----- Requirements -----------------------------------------------------
44
45(require 'compile)
46(require 'comint)
7abe197c
JB
47(require 'find-file)
48(require 'ada-mode)
797aab3c 49
797aab3c
GM
50;; ------ Use variables
51(defcustom ada-xref-other-buffer t
eec3232e
GM
52 "*If nil, always display the cross-references in the same buffer.
53Otherwise create either a new buffer or a new frame."
797aab3c
GM
54 :type 'boolean :group 'ada)
55
93cdce20 56(defcustom ada-xref-create-ali nil
eec3232e
GM
57 "*If non-nil, run gcc whenever the cross-references are not up-to-date.
58If nil, the cross-reference mode will never run gcc."
797aab3c
GM
59 :type 'boolean :group 'ada)
60
61(defcustom ada-xref-confirm-compile nil
eec3232e
GM
62 "*If non-nil, always ask for user confirmation before compiling or running
63the application."
797aab3c
GM
64 :type 'boolean :group 'ada)
65
66(defcustom ada-krunch-args "0"
eec3232e
GM
67 "*Maximum number of characters for filenames created by gnatkr.
68Set to 0, if you don't use crunched filenames. This should be a string."
797aab3c
GM
69 :type 'string :group 'ada)
70
c94ca9e0
JB
71(defcustom ada-gnatls-args '("-v")
72 "*Arguments to pass to gnatfind when the location of the runtime is searched.
73Typical use is to pass --RTS=soft-floats on some systems that support it.
74
75You can also add -I- if you do not want the current directory to be included.
76Otherwise, going from specs to bodies and back will first look for files in the
77current directory. This only has an impact if you are not using project files,
78but only ADA_INCLUDE_PATH."
79 :type '(repeat string) :group 'ada)
80
4884c50b 81(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
15ea3b67
GM
82 "Default compilation options."
83 :type 'string :group 'ada)
84
85(defcustom ada-prj-default-bind-opt ""
86 "Default binder options."
87 :type 'string :group 'ada)
88
89(defcustom ada-prj-default-link-opt ""
90 "Default linker options."
91 :type 'string :group 'ada)
92
93(defcustom ada-prj-default-gnatmake-opt "-g"
94 "Default options for gnatmake."
95 :type 'string :group 'ada)
96
4884c50b
SM
97(defcustom ada-prj-gnatfind-switches "-rf"
98 "Default switches to use for gnatfind.
99You should modify this variable, for instance to add -a, if you are working
100in an environment where most ALI files are write-protected.
101The command gnatfind is used every time you choose the menu
102\"Show all references\"."
103 :type 'string :group 'ada)
104
eec3232e 105(defcustom ada-prj-default-comp-cmd
93cdce20
SM
106 (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
107 " ${comp_opt}")
797aab3c 108 "*Default command to be used to compile a single file.
15ea3b67
GM
109Emacs will add the filename at the end of this command. This is the same
110syntax as in the project file."
111 :type 'string :group 'ada)
112
113(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
114 "*Default name of the debugger. We recommend either `gdb',
115`gdb --emacs_gdbtk' or `ddd --tty -fullname'."
797aab3c
GM
116 :type 'string :group 'ada)
117
118(defcustom ada-prj-default-make-cmd
15ea3b67
GM
119 (concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} "
120 "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
797aab3c
GM
121 "*Default command to be used to compile the application.
122This is the same syntax as in the project file."
123 :type 'string :group 'ada)
124
125(defcustom ada-prj-default-project-file ""
eec3232e
GM
126 "*Name of the project file to use for every Ada file.
127Emacs will not try to use the standard algorithm to find the project file if
128this string is not empty."
797aab3c
GM
129 :type '(file :must-match t) :group 'ada)
130
131(defcustom ada-gnatstub-opts "-q -I${src_dir}"
eec3232e
GM
132 "*List of the options to pass to gnatsub to generate the body of a package.
133This has the same syntax as in the project file (with variable substitution)."
797aab3c
GM
134 :type 'string :group 'ada)
135
136(defcustom ada-always-ask-project nil
eec3232e 137 "*If nil, use default values when no project file was found.
15ea3b67
GM
138Otherwise, ask the user for the name of the project file to use."
139 :type 'boolean :group 'ada)
797aab3c 140
4884c50b
SM
141(defconst is-windows (memq system-type (quote (windows-nt)))
142 "True if we are running on windows NT or windows 95.")
143
144(defcustom ada-tight-gvd-integration nil
145 "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
146If GVD is not the debugger used, nothing happens.")
147
93cdce20
SM
148(defcustom ada-xref-search-with-egrep t
149 "*If non-nil, use egrep to find the possible declarations for an entity.
150This alternate method is used when the exact location was not found in the
151information provided by GNAT. However, it might be expensive if you have a lot
152of sources, since it will search in all the files in your project."
153 :type 'boolean :group 'ada)
154
155(defvar ada-load-project-hook nil
156 "Hook that is run when loading a project file.
157Each function in this hook takes one argument FILENAME, that is the name of
158the project file to load.
159This hook should be used to support new formats for the project files.
160
161If the function can load the file with the given filename, it should create a
162buffer that contains a conversion of the file to the standard format of the
163project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\"
164lines). It should return nil if it doesn't know how to convert that project
165file.")
166
167
797aab3c
GM
168;; ------- Nothing to be modified by the user below this
169(defvar ada-last-prj-file ""
eec3232e 170 "Name of the last project file entered by the user.")
797aab3c 171
15ea3b67 172(defvar ada-check-switch "-gnats"
eec3232e 173 "Switch added to the command line to check the current file.")
797aab3c 174
4884c50b 175(defconst ada-project-file-extension ".adp"
eec3232e 176 "The extension used for project files.")
797aab3c 177
15ea3b67
GM
178(defvar ada-xref-runtime-library-specs-path '()
179 "Directories where the specs for the standard library is found.
180This is used for cross-references.")
181
182(defvar ada-xref-runtime-library-ali-path '()
183 "Directories where the ali for the standard library is found.
184This is used for cross-references.")
185
797aab3c 186(defvar ada-xref-pos-ring '()
eec3232e
GM
187 "List of positions selected by the cross-references functions.
188Used to go back to these positions.")
797aab3c 189
4884c50b
SM
190(defvar ada-cd-command
191 (if (string-match "cmdproxy.exe" shell-file-name)
192 "cd /d"
193 "cd")
194 "Command to use to change to a specific directory. On windows systems
195using cmdproxy.exe as the shell, we need to use /d or the drive is never
196changed.")
197
198(defvar ada-command-separator (if is-windows " && " "\n")
199 "Separator to use when sending multiple commands to `compile' or
200`start-process'.
201cmdproxy.exe doesn't recognize multiple-line commands, so we have to use
202\"&&\" for now.")
203
797aab3c 204(defconst ada-xref-pos-ring-max 16
eec3232e 205 "Number of positions kept in the list ada-xref-pos-ring.")
797aab3c
GM
206
207(defvar ada-operator-re
15ea3b67 208 "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
eec3232e 209 "Regexp to match for operators.")
797aab3c 210
15ea3b67
GM
211(defvar ada-xref-project-files '()
212 "Associative list of project files.
213It has the following format:
fea24571 214\((project_name . value) (project_name . value) ...)
15ea3b67
GM
215As always, the values of the project file are defined through properties.")
216
c94ca9e0
JB
217
218;; ----- Identlist manipulation -------------------------------------------
219;; An identlist is a vector that is used internally to reference an identifier
220;; To facilitate its use, we provide the following macros
221
222(defmacro ada-make-identlist () (make-vector 8 nil))
223(defmacro ada-name-of (identlist) (list 'aref identlist 0))
224(defmacro ada-line-of (identlist) (list 'aref identlist 1))
225(defmacro ada-column-of (identlist) (list 'aref identlist 2))
226(defmacro ada-file-of (identlist) (list 'aref identlist 3))
227(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4))
228(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5))
229(defmacro ada-references-of (identlist) (list 'aref identlist 6))
230(defmacro ada-on-declaration (identlist) (list 'aref identlist 7))
231
232(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name))
233(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line))
234(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col))
235(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file))
236(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index))
237(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file))
238(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref))
239(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
240
241(defsubst ada-get-ali-buffer (file)
242 "Reads the ali file into a new buffer, and returns this buffer's name"
243 (find-file-noselect (ada-get-ali-file-name file)))
244
245
246;; -----------------------------------------------------------------------
247
4884c50b
SM
248(defun ada-quote-cmd (cmd)
249 "Duplicates all \\ characters in CMD so that it can be passed to `compile'"
250 (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
15ea3b67 251
4884c50b
SM
252(defun ada-initialize-runtime-library (cross-prefix)
253 "Initializes the variables for the runtime library location.
254CROSS-PREFIX is the prefix to use for the gnatls command"
15ea3b67 255 (save-excursion
4884c50b
SM
256 (setq ada-xref-runtime-library-specs-path '()
257 ada-xref-runtime-library-ali-path '())
15ea3b67
GM
258 (set-buffer (get-buffer-create "*gnatls*"))
259 (widen)
260 (erase-buffer)
261 ;; Catch any error in the following form (i.e gnatls was not found)
262 (condition-case nil
263 ;; Even if we get an error, delete the *gnatls* buffer
264 (unwind-protect
265 (progn
c94ca9e0
JB
266 (apply 'call-process (concat cross-prefix "gnatls")
267 (append '(nil t nil) ada-gnatls-args))
15ea3b67
GM
268 (goto-char (point-min))
269
270 ;; Source path
a1506d29 271
15ea3b67
GM
272 (search-forward "Source Search Path:")
273 (forward-line 1)
274 (while (not (looking-at "^$"))
275 (back-to-indentation)
c94ca9e0
JB
276 (if (looking-at "<Current_Directory>")
277 (add-to-list 'ada-xref-runtime-library-specs-path ".")
15ea3b67
GM
278 (add-to-list 'ada-xref-runtime-library-specs-path
279 (buffer-substring-no-properties
280 (point)
281 (save-excursion (end-of-line) (point)))))
282 (forward-line 1))
283
284 ;; Object path
a1506d29 285
15ea3b67
GM
286 (search-forward "Object Search Path:")
287 (forward-line 1)
288 (while (not (looking-at "^$"))
289 (back-to-indentation)
c94ca9e0
JB
290 (if (looking-at "<Current_Directory>")
291 (add-to-list 'ada-xref-runtime-library-ali-path ".")
15ea3b67
GM
292 (add-to-list 'ada-xref-runtime-library-ali-path
293 (buffer-substring-no-properties
294 (point)
295 (save-excursion (end-of-line) (point)))))
296 (forward-line 1))
297 )
298 (kill-buffer nil))
299 (error nil))
300 (set 'ada-xref-runtime-library-specs-path
301 (reverse ada-xref-runtime-library-specs-path))
302 (set 'ada-xref-runtime-library-ali-path
303 (reverse ada-xref-runtime-library-ali-path))
304 ))
305
306
307(defun ada-treat-cmd-string (cmd-string)
308 "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
309The project file must have been loaded first.
310As a special case, ${current} is replaced with the name of the currently
4884c50b
SM
311edited file, minus extension but with directory, and ${full_current} is
312replaced by the name including the extension."
15ea3b67
GM
313
314 (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)
4884c50b
SM
315 (let (value
316 (name (match-string 2 cmd-string)))
317 (cond
318 ((string= name "current")
319 (setq value (file-name-sans-extension (buffer-file-name))))
320 ((string= name "full_current")
321 (setq value (buffer-file-name)))
322 (t
15ea3b67 323 (save-match-data
4884c50b
SM
324 (setq value (ada-xref-get-project-field (intern name))))))
325
326 ;; Check if there is an environment variable with the same name
327 (if (null value)
328 (if (not (setq value (getenv name)))
329 (message (concat "No environment variable " name " found"))))
a1506d29 330
15ea3b67
GM
331 (cond
332 ((null value)
4884c50b 333 (setq cmd-string (replace-match "" t t cmd-string)))
15ea3b67 334 ((stringp value)
4884c50b 335 (setq cmd-string (replace-match value t t cmd-string)))
15ea3b67
GM
336 ((listp value)
337 (let ((prefix (match-string 1 cmd-string)))
4884c50b 338 (setq cmd-string (replace-match
15ea3b67
GM
339 (mapconcat (lambda(x) (concat prefix x)) value " ")
340 t t cmd-string)))))
341 ))
342 cmd-string)
343
344(defun ada-xref-set-default-prj-values (symbol ada-buffer)
345 "Reset the properties in SYMBOL to the default values for ADA-BUFFER."
346
347 (let ((file (buffer-file-name ada-buffer))
348 plist)
349 (save-excursion
350 (set-buffer ada-buffer)
a1506d29 351
15ea3b67
GM
352 (set 'plist
353 ;; Try hard to find a default value for filename, so that the user
354 ;; can edit his project file even if the current buffer is not an
355 ;; Ada file or not even associated with a file
4884c50b
SM
356 (list 'filename (expand-file-name
357 (cond
4884c50b
SM
358 (ada-prj-default-project-file
359 ada-prj-default-project-file)
c94ca9e0 360 (file (ada-prj-find-prj-file file t))
4884c50b
SM
361 (t
362 (message (concat "Not editing an Ada file,"
363 "and no default project "
364 "file specified!"))
365 "")))
15ea3b67
GM
366 'build_dir (file-name-as-directory (expand-file-name "."))
367 'src_dir (list ".")
368 'obj_dir (list ".")
369 'casing (if (listp ada-case-exception-file)
370 ada-case-exception-file
371 (list ada-case-exception-file))
372 'comp_opt ada-prj-default-comp-opt
373 'bind_opt ada-prj-default-bind-opt
374 'link_opt ada-prj-default-link-opt
375 'gnatmake_opt ada-prj-default-gnatmake-opt
4884c50b 376 'gnatfind_opt ada-prj-gnatfind-switches
15ea3b67 377 'main (if file
4884c50b
SM
378 (file-name-nondirectory
379 (file-name-sans-extension file))
15ea3b67
GM
380 "")
381 'main_unit (if file
382 (file-name-nondirectory
383 (file-name-sans-extension file))
384 "")
385 'cross_prefix ""
386 'remote_machine ""
4884c50b
SM
387 'comp_cmd (list (concat ada-cd-command " ${build_dir}")
388 ada-prj-default-comp-cmd)
389 'check_cmd (list (concat ada-prj-default-comp-cmd " "
390 ada-check-switch))
391 'make_cmd (list (concat ada-cd-command " ${build_dir}")
392 ada-prj-default-make-cmd)
393 'run_cmd (list (concat ada-cd-command " ${build_dir}")
394 (concat "${main}"
395 (if is-windows ".exe")))
396 'debug_pre_cmd (list (concat ada-cd-command
397 " ${build_dir}"))
15ea3b67
GM
398 'debug_cmd (concat ada-prj-default-debugger
399 (if is-windows " ${main}.exe"
4884c50b
SM
400 " ${main}"))
401 'debug_post_cmd (list nil)))
15ea3b67
GM
402 )
403 (set symbol plist)))
a1506d29 404
15ea3b67 405(defun ada-xref-get-project-field (field)
4884c50b 406 "Extract the value of FIELD from the current project file.
15ea3b67 407The project file must have been loaded first.
4884c50b
SM
408A default value is returned if the file was not found.
409
410Note that for src_dir and obj_dir, you should rather use
411`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in
412addition return the default paths."
15ea3b67 413
4884c50b 414 (let ((file-name ada-prj-default-project-file)
15ea3b67
GM
415 file value)
416
4884c50b
SM
417 ;; Get the project file (either the current one, or a default one)
418 (setq file (or (assoc file-name ada-xref-project-files)
419 (assoc nil ada-xref-project-files)))
a1506d29 420
15ea3b67
GM
421 ;; If the file was not found, use the default values
422 (if file
423 ;; Get the value from the file
424 (set 'value (plist-get (cdr file) field))
425
426 ;; Create a default nil file that contains the default values
427 (ada-xref-set-default-prj-values 'value (current-buffer))
428 (add-to-list 'ada-xref-project-files (cons nil value))
4884c50b 429 (ada-xref-update-project-menu)
15ea3b67
GM
430 (set 'value (plist-get value field))
431 )
4884c50b
SM
432
433 ;; Substitute the ${...} constructs in all the strings, including
434 ;; inside lists
435 (cond
436 ((stringp value)
437 (ada-treat-cmd-string value))
438 ((null value)
439 nil)
440 ((listp value)
441 (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value))
442 (t
443 value)
444 )
445 ))
446
447
448(defun ada-xref-get-src-dir-field ()
449 "Return the full value for src_dir, including the default directories.
450All the directories are returned as absolute directories."
451
452 (let ((build-dir (ada-xref-get-project-field 'build_dir)))
453 (append
454 ;; Add ${build_dir} in front of the path
455 (list build-dir)
a1506d29 456
4884c50b
SM
457 (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)
458 build-dir)
a1506d29 459
4884c50b
SM
460 ;; Add the standard runtime at the end
461 ada-xref-runtime-library-specs-path)))
462
463(defun ada-xref-get-obj-dir-field ()
464 "Return the full value for obj_dir, including the default directories.
465All the directories are returned as absolute directories."
466
467 (let ((build-dir (ada-xref-get-project-field 'build_dir)))
468 (append
469 ;; Add ${build_dir} in front of the path
470 (list build-dir)
a1506d29 471
4884c50b
SM
472 (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir)
473 build-dir)
a1506d29 474
4884c50b
SM
475 ;; Add the standard runtime at the end
476 ada-xref-runtime-library-ali-path)))
477
478(defun ada-xref-update-project-menu ()
479 "Update the menu Ada->Project, with the list of available project files."
4884c50b
SM
480 (let (submenu)
481
482 ;; Create the standard items
483 (set 'submenu (list (cons 'Load (cons "Load..."
484 'ada-set-default-project-file))
485 (cons 'New (cons "New..." 'ada-prj-new))
486 (cons 'Edit (cons "Edit..." 'ada-prj-edit))
487 (cons 'sep (cons "---" nil))))
a1506d29 488
4884c50b
SM
489 ;; Add the new items
490 (mapcar
491 (lambda (x)
492 (let ((name (or (car x) "<default>"))
493 (command `(lambda ()
494 "Change the active project file."
495 (interactive)
496 (ada-parse-prj-file ,(car x))
497 (set 'ada-prj-default-project-file ,(car x))
498 (ada-xref-update-project-menu))))
499 (set 'submenu
500 (append submenu
501 (list (cons (intern name)
502 (list
93cdce20
SM
503 'menu-item
504 (if (string= (file-name-extension name)
505 ada-project-file-extension)
506 (file-name-sans-extension
507 (file-name-nondirectory name))
508 (file-name-nondirectory name))
4884c50b
SM
509 command
510 :button (cons
511 :toggle
512 (equal ada-prj-default-project-file
513 (car x))
514 ))))))))
a1506d29 515
4884c50b
SM
516 ;; Parses all the known project files, and insert at least the default
517 ;; one (in case ada-xref-project-files is nil)
518 (or ada-xref-project-files '(nil)))
519
7abe197c 520 (if (not (featurep 'xemacs))
c94ca9e0
JB
521 (if (lookup-key ada-mode-map [menu-bar Ada Project])
522 (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])
523 submenu)))
524 ))
4884c50b
SM
525
526
527;;-------------------------------------------------------------
528;;-- Searching a file anywhere on the source path.
529;;--
530;;-- The following functions provide support for finding a file anywhere
531;;-- on the source path, without providing an explicit directory.
532;;-- They also provide file name completion in the minibuffer.
533;;--
534;;-- Public subprograms: ada-find-file
535;;--
536;;-------------------------------------------------------------
537
538(defun ada-do-file-completion (string predicate flag)
539 "Completion function when reading a file from the minibuffer.
540Completion is attempted in all the directories in the source path, as
541defined in the project file."
542 (let (list
543 (dirs (ada-xref-get-src-dir-field)))
544
545 (while dirs
546 (if (file-directory-p (car dirs))
547 (set 'list (append list (file-name-all-completions string (car dirs)))))
548 (set 'dirs (cdr dirs)))
549 (cond ((equal flag 'lambda)
550 (assoc string list))
551 (flag
552 list)
553 (t
554 (try-completion string
555 (mapcar (lambda (x) (cons x 1)) list)
556 predicate)))))
557
558;;;###autoload
559(defun ada-find-file (filename)
560 "Open a file anywhere in the source path.
561Completion is available."
562 (interactive
563 (list (completing-read "File: " 'ada-do-file-completion)))
564 (let ((file (ada-find-src-file-in-dir filename)))
565 (if file
566 (find-file file)
567 (error (concat filename " not found in src_dir")))))
568
797aab3c 569
797aab3c
GM
570;; ----- Utilities -------------------------------------------------
571
572(defun ada-require-project-file ()
4884c50b
SM
573 "If no project file is currently active, load a default one."
574 (if (or (not ada-prj-default-project-file)
575 (not ada-xref-project-files)
576 (string= ada-prj-default-project-file ""))
15ea3b67 577 (ada-reread-prj-file)))
a1506d29 578
797aab3c 579(defun ada-xref-push-pos (filename position)
eec3232e 580 "Push (FILENAME, POSITION) on the position ring for cross-references."
797aab3c
GM
581 (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring))
582 (if (> (length ada-xref-pos-ring) ada-xref-pos-ring-max)
583 (setcdr (nthcdr (1- ada-xref-pos-ring-max) ada-xref-pos-ring) nil)))
584
585(defun ada-xref-goto-previous-reference ()
eec3232e 586 "Go to the previous cross-reference we were on."
797aab3c
GM
587 (interactive)
588 (if ada-xref-pos-ring
eec3232e
GM
589 (let ((pos (car ada-xref-pos-ring)))
590 (setq ada-xref-pos-ring (cdr ada-xref-pos-ring))
591 (find-file (car (cdr pos)))
592 (goto-char (car pos)))))
797aab3c
GM
593
594(defun ada-convert-file-name (name)
eec3232e
GM
595 "Converts from NAME to a name that can be used by the compilation commands.
596This is overriden on VMS to convert from VMS filenames to Unix filenames."
797aab3c
GM
597 name)
598
c94ca9e0
JB
599(defun ada-set-default-project-file (name &optional keep-existing)
600 "Set the file whose name is NAME as the default project file.
601If KEEP-EXISTING is true and a project file has already been loaded, nothing
602is done. This is meant to be used from ada-mode-hook, for instance to force
603a project file unless the user has already loaded one."
eec3232e 604 (interactive "fProject file:")
c94ca9e0
JB
605 (if (or (not keep-existing)
606 (not ada-prj-default-project-file)
607 (equal ada-prj-default-project-file ""))
608 (progn
609 (setq ada-prj-default-project-file name)
610 (ada-reread-prj-file name))))
15ea3b67
GM
611
612;; ------ Handling the project file -----------------------------
797aab3c 613
c94ca9e0
JB
614(defun ada-prj-find-prj-file (&optional file no-user-question)
615 "Find the prj file associated with FILE (or the current buffer if nil).
15ea3b67
GM
616If NO-USER-QUESTION is non-nil, use a default file if not project file was
617found, and do not ask the user.
618If the buffer is not an Ada buffer, associate it with the default project
619file. If none is set, return nil."
797aab3c 620
15ea3b67 621 (let (selected)
797aab3c 622
4884c50b
SM
623 ;; Use the active project file if there is one.
624 ;; This is also valid if we don't currently have an Ada buffer, or if
625 ;; the current buffer is not a real file (for instance an emerge buffer)
a1506d29 626
15ea3b67 627 (if (or (not (string= mode-name "Ada"))
c94ca9e0
JB
628 (not (buffer-file-name)))
629
630 (if (and ada-prj-default-project-file
631 (not (string= ada-prj-default-project-file "")))
632 (setq selected ada-prj-default-project-file)
633 (setq selected nil))
a1506d29 634
4884c50b 635 ;; other cases: use a more complex algorithm
a1506d29 636
c94ca9e0 637 (let* ((current-file (or file (buffer-file-name)))
4884c50b
SM
638 (first-choice (concat
639 (file-name-sans-extension current-file)
640 ada-project-file-extension))
641 (dir (file-name-directory current-file))
a1506d29 642
4884c50b
SM
643 ;; on Emacs 20.2, directory-files does not work if
644 ;; parse-sexp-lookup-properties is set
645 (parse-sexp-lookup-properties nil)
646 (prj-files (directory-files
647 dir t
648 (concat ".*" (regexp-quote
649 ada-project-file-extension) "$")))
650 (choice nil))
a1506d29 651
4884c50b 652 (cond
a1506d29 653
4884c50b
SM
654 ;; Else if there is a project file with the same name as the Ada
655 ;; file, but not the same extension.
656 ((file-exists-p first-choice)
657 (set 'selected first-choice))
a1506d29 658
4884c50b
SM
659 ;; Else if only one project file was found in the current directory
660 ((= (length prj-files) 1)
661 (set 'selected (car prj-files)))
a1506d29 662
4884c50b
SM
663 ;; Else if there are multiple files, ask the user
664 ((and (> (length prj-files) 1) (not no-user-question))
665 (save-window-excursion
666 (with-output-to-temp-buffer "*choice list*"
667 (princ "There are more than one possible project file.\n")
668 (princ "Which one should we use ?\n\n")
669 (princ " no. file name \n")
670 (princ " --- ------------------------\n")
671 (let ((counter 1))
672 (while (<= counter (length prj-files))
673 (princ (format " %2d) %s\n"
674 counter
675 (nth (1- counter) prj-files)))
676 (setq counter (1+ counter))
c94ca9e0 677
4884c50b
SM
678 ))) ; end of with-output-to ...
679 (setq choice nil)
680 (while (or
681 (not choice)
682 (not (integerp choice))
683 (< choice 1)
684 (> choice (length prj-files)))
685 (setq choice (string-to-int
686 (read-from-minibuffer "Enter No. of your choice: "))))
687 (set 'selected (nth (1- choice) prj-files))))
a1506d29 688
4884c50b
SM
689 ;; Else if no project file was found in the directory, ask a name
690 ;; to the user, using as a default value the last one entered by
691 ;; the user
692 ((= (length prj-files) 0)
693 (unless (or no-user-question (not ada-always-ask-project))
694 (setq ada-last-prj-file
695 (read-file-name
696 (concat "project file [" ada-last-prj-file "]:")
697 nil ada-last-prj-file))
698 (unless (string= ada-last-prj-file "")
699 (set 'selected ada-last-prj-file))))
700 )))
c94ca9e0
JB
701
702 (or selected "default.adp")
797aab3c
GM
703 ))
704
705
15ea3b67
GM
706(defun ada-parse-prj-file (prj-file)
707 "Reads and parses the PRJ-FILE file if it was found.
708The current buffer should be the ada-file buffer."
709 (if prj-file
4884c50b
SM
710 (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing
711 run_cmd debug_pre_cmd debug_post_cmd
15ea3b67 712 (ada-buffer (current-buffer)))
4884c50b 713 (setq prj-file (expand-file-name prj-file))
15ea3b67 714
c94ca9e0
JB
715 ;; Set the project file as the active one.
716 (setq ada-prj-default-project-file prj-file)
717
15ea3b67
GM
718 ;; Initialize the project with the default values
719 (ada-xref-set-default-prj-values 'project (current-buffer))
720
721 ;; Do not use find-file below, since we don't want to show this
722 ;; buffer. If the file is open through speedbar, we can't use
723 ;; find-file anyway, since the speedbar frame is special and does not
724 ;; allow the selection of a file in it.
725
c94ca9e0
JB
726 (if (file-exists-p prj-file)
727 (progn
728 (let* ((buffer (run-hook-with-args-until-success
729 'ada-load-project-hook prj-file)))
730 (unless buffer
7abe197c
JB
731 (setq buffer (find-file-noselect prj-file nil)))
732 (set-buffer buffer))
733
734 (widen)
735 (goto-char (point-min))
736
737 ;; Now overrides these values with the project file
738 (while (not (eobp))
739 (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
740 (cond
741 ((string= (match-string 1) "src_dir")
742 (add-to-list 'src_dir
743 (file-name-as-directory (match-string 2))))
744 ((string= (match-string 1) "obj_dir")
745 (add-to-list 'obj_dir
746 (file-name-as-directory (match-string 2))))
747 ((string= (match-string 1) "casing")
748 (set 'casing (cons (match-string 2) casing)))
749 ((string= (match-string 1) "build_dir")
750 (set 'project
751 (plist-put project 'build_dir
752 (file-name-as-directory (match-string 2)))))
753 ((string= (match-string 1) "make_cmd")
754 (add-to-list 'make_cmd (match-string 2)))
755 ((string= (match-string 1) "comp_cmd")
756 (add-to-list 'comp_cmd (match-string 2)))
757 ((string= (match-string 1) "check_cmd")
758 (add-to-list 'check_cmd (match-string 2)))
759 ((string= (match-string 1) "run_cmd")
760 (add-to-list 'run_cmd (match-string 2)))
761 ((string= (match-string 1) "debug_pre_cmd")
762 (add-to-list 'debug_pre_cmd (match-string 2)))
763 ((string= (match-string 1) "debug_post_cmd")
764 (add-to-list 'debug_post_cmd (match-string 2)))
765 (t
766 (set 'project (plist-put project (intern (match-string 1))
767 (match-string 2))))))
768 (forward-line 1))
769
770 (if src_dir (set 'project (plist-put project 'src_dir
771 (reverse src_dir))))
772 (if obj_dir (set 'project (plist-put project 'obj_dir
773 (reverse obj_dir))))
774 (if casing (set 'project (plist-put project 'casing
775 (reverse casing))))
776 (if make_cmd (set 'project (plist-put project 'make_cmd
777 (reverse make_cmd))))
778 (if comp_cmd (set 'project (plist-put project 'comp_cmd
779 (reverse comp_cmd))))
780 (if check_cmd (set 'project (plist-put project 'check_cmd
781 (reverse check_cmd))))
782 (if run_cmd (set 'project (plist-put project 'run_cmd
783 (reverse run_cmd))))
784 (set 'project (plist-put project 'debug_post_cmd
785 (reverse debug_post_cmd)))
c94ca9e0
JB
786 (set 'project (plist-put project 'debug_pre_cmd
787 (reverse debug_pre_cmd)))
788
789 ;; Kill the project buffer
790 (kill-buffer nil)
791 (set-buffer ada-buffer)
792 )
793
794 ;; Else the file wasn't readable (probably the default project).
795 ;; We initialize it with the current environment variables.
796 ;; We need to add the startup directory in front so that
797 ;; files locally redefined are properly found. We cannot
798 ;; add ".", which varies too much depending on what the
799 ;; current buffer is.
800 (set 'project
801 (plist-put project 'src_dir
802 (append
803 (list command-line-default-directory)
804 (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
805 (list "." default-directory))))
806 (set 'project
807 (plist-put project 'obj_dir
808 (append
809 (list command-line-default-directory)
810 (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":")
811 (list "." default-directory))))
812 )
813
4884c50b
SM
814
815 ;; Delete the default project file from the list, if it is there.
816 ;; Note that in that case, this default project is the only one in
817 ;; the list
818 (if (assoc nil ada-xref-project-files)
819 (setq ada-xref-project-files nil))
a1506d29 820
15ea3b67
GM
821 ;; Memorize the newly read project file
822 (if (assoc prj-file ada-xref-project-files)
823 (setcdr (assoc prj-file ada-xref-project-files) project)
824 (add-to-list 'ada-xref-project-files (cons prj-file project)))
4884c50b 825
15ea3b67
GM
826 ;; Sets up the compilation-search-path so that Emacs is able to
827 ;; go to the source of the errors in a compilation buffer
4884c50b
SM
828 (setq compilation-search-path (ada-xref-get-src-dir-field))
829
830 ;; Set the casing exceptions file list
831 (if casing
832 (progn
833 (setq ada-case-exception-file (reverse casing))
834 (ada-case-read-exceptions)))
a1506d29 835
15ea3b67
GM
836 ;; Add the directories to the search path for ff-find-other-file
837 ;; Do not add the '/' or '\' at the end
7abe197c 838 (setq ada-search-directories-internal
15ea3b67
GM
839 (append (mapcar 'directory-file-name compilation-search-path)
840 ada-search-directories))
a1506d29 841
4884c50b 842 (ada-xref-update-project-menu)
15ea3b67 843 )
4884c50b
SM
844
845 ;; No prj file ? => Setup default values
846 ;; Note that nil means that all compilation modes will first look in the
847 ;; current directory, and only then in the current file's directory. This
848 ;; current file is assumed at this point to be in the common source
849 ;; directory.
850 (setq compilation-search-path (list nil default-directory))
15ea3b67 851 ))
a1506d29
JB
852
853
93cdce20 854(defun ada-find-references (&optional pos arg local-only)
eec3232e 855 "Find all references to the entity under POS.
93cdce20
SM
856Calls gnatfind to find the references.
857if ARG is t, the contents of the old *gnatfind* buffer is preserved.
858if LOCAL-ONLY is t, only the declarations in the current file are returned."
859 (interactive "d
860P")
797aab3c
GM
861 (ada-require-project-file)
862
863 (let* ((identlist (ada-read-identifier pos))
15ea3b67
GM
864 (alifile (ada-get-ali-file-name (ada-file-of identlist)))
865 (process-environment (ada-set-environment)))
797aab3c
GM
866
867 (set-buffer (get-file-buffer (ada-file-of identlist)))
868
869 ;; if the file is more recent than the executable
870 (if (or (buffer-modified-p (current-buffer))
871 (file-newer-than-file-p (ada-file-of identlist) alifile))
872 (ada-find-any-references (ada-name-of identlist)
873 (ada-file-of identlist)
93cdce20 874 nil nil local-only arg)
797aab3c
GM
875 (ada-find-any-references (ada-name-of identlist)
876 (ada-file-of identlist)
877 (ada-line-of identlist)
93cdce20 878 (ada-column-of identlist) local-only arg)))
797aab3c
GM
879 )
880
93cdce20
SM
881(defun ada-find-local-references (&optional pos arg)
882 "Find all references to the entity under POS.
883Calls gnatfind to find the references.
884if ARG is t, the contents of the old *gnatfind* buffer is preserved."
885 (interactive "d
886P")
887 (ada-find-references pos arg t))
888
889(defun ada-find-any-references
890 (entity &optional file line column local-only append)
eec3232e 891 "Search for references to any entity whose name is ENTITY.
93cdce20
SM
892ENTITY was first found the location given by FILE, LINE and COLUMN.
893If LOCAL-ONLY is t, then only the references in file will be listed, which
894is much faster.
895If APPEND is t, then the output of the command will be append to the existing
896buffer *gnatfind* if it exists."
797aab3c
GM
897 (interactive "sEntity name: ")
898 (ada-require-project-file)
899
4884c50b
SM
900 ;; Prepare the gnatfind command. Note that we must protect the quotes
901 ;; around operators, so that they are correctly handled and can be
902 ;; processed (gnatfind \"+\":...).
903 (let* ((quote-entity
904 (if (= (aref entity 0) ?\")
905 (if is-windows
906 (concat "\\\"" (substring entity 1 -1) "\\\"")
907 (concat "'\"" (substring entity 1 -1) "\"'"))
908 entity))
909 (switches (ada-xref-get-project-field 'gnatfind_opt))
7abe197c 910 (command (concat "gnat find " switches " "
4884c50b 911 quote-entity
797aab3c
GM
912 (if file (concat ":" (file-name-nondirectory file)))
913 (if line (concat ":" line))
93cdce20
SM
914 (if column (concat ":" column))
915 (if local-only (concat " " (file-name-nondirectory file)))
916 ))
917 old-contents)
797aab3c
GM
918
919 ;; If a project file is defined, use it
4884c50b
SM
920 (if (and ada-prj-default-project-file
921 (not (string= ada-prj-default-project-file "")))
7abe197c
JB
922 (if (string-equal (file-name-extension ada-prj-default-project-file)
923 "gpr")
924 (setq command (concat command " -P" ada-prj-default-project-file))
925 (setq command (concat command " -p" ada-prj-default-project-file))))
797aab3c 926
93cdce20
SM
927 (if (and append (get-buffer "*gnatfind*"))
928 (save-excursion
929 (set-buffer "*gnatfind*")
930 (setq old-contents (buffer-string))))
a1506d29 931
eec3232e 932 (compile-internal command "No more references" "gnatfind")
797aab3c
GM
933
934 ;; Hide the "Compilation" menu
935 (save-excursion
936 (set-buffer "*gnatfind*")
93cdce20
SM
937 (local-unset-key [menu-bar compilation-menu])
938
939 (if old-contents
940 (progn
941 (goto-char 1)
942 (insert old-contents)
943 (goto-char (point-max)))))
797aab3c
GM
944 )
945 )
946
4884c50b 947(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
797aab3c 948
797aab3c
GM
949;; ----- Identifier Completion --------------------------------------------
950(defun ada-complete-identifier (pos)
951 "Tries to complete the identifier around POS.
15ea3b67 952The feature is only available if the files where compiled not using the -gnatx
eec3232e 953option."
797aab3c
GM
954 (interactive "d")
955 (ada-require-project-file)
956
15ea3b67 957 ;; Initialize function-local variables and jump to the .ali buffer
797aab3c
GM
958 ;; Note that for regexp search is case insensitive too
959 (let* ((curbuf (current-buffer))
960 (identlist (ada-read-identifier pos))
961 (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\("
962 (regexp-quote (ada-name-of identlist))
963 "[a-zA-Z0-9_]*\\)"))
964 (completed nil)
15ea3b67 965 (symalist nil))
797aab3c 966
15ea3b67
GM
967 ;; Open the .ali file
968 (set-buffer (ada-get-ali-buffer (buffer-file-name)))
797aab3c
GM
969 (goto-char (point-max))
970
971 ;; build an alist of possible completions
972 (while (re-search-backward sofar nil t)
973 (setq symalist (cons (cons (match-string 1) nil) symalist)))
974
975 (setq completed (try-completion "" symalist))
976
977 ;; kills .ali buffer
978 (kill-buffer nil)
979
980 ;; deletes the incomplete identifier in the buffer
981 (set-buffer curbuf)
982 (looking-at "[a-zA-Z0-9_]+")
983 (replace-match "")
984 ;; inserts the completed symbol
985 (insert completed)
986 ))
987
988;; ----- Cross-referencing ----------------------------------------
989
990(defun ada-point-and-xref ()
c94ca9e0 991 "Jump to the declaration of the entity below the cursor."
797aab3c
GM
992 (interactive)
993 (mouse-set-point last-input-event)
994 (ada-goto-declaration (point)))
995
c94ca9e0
JB
996(defun ada-point-and-xref-body ()
997 "Jump to the body of the entity under the cursor."
998 (interactive)
999 (mouse-set-point last-input-event)
1000 (ada-goto-body (point)))
1001
1002(defun ada-goto-body (pos &optional other-frame)
1003 "Display the body of the entity around POS.
1004If the entity doesn't have a body, display its declaration.
1005As a side effect, the buffer for the declaration is also open."
1006 (interactive "d")
1007 (ada-goto-declaration pos other-frame)
1008
1009 ;; Temporarily force the display in the same buffer, since we
1010 ;; already changed previously
1011 (let ((ada-xref-other-buffer nil))
1012 (ada-goto-declaration (point) nil)))
1013
4884c50b 1014(defun ada-goto-declaration (pos &optional other-frame)
eec3232e
GM
1015 "Display the declaration of the identifier around POS.
1016The declaration is shown in another buffer if `ada-xref-other-buffer' is
4884c50b
SM
1017non-nil.
1018If OTHER-FRAME is non-nil, display the cross-reference in another frame."
797aab3c
GM
1019 (interactive "d")
1020 (ada-require-project-file)
1021 (push-mark pos)
1022 (ada-xref-push-pos (buffer-file-name) pos)
797aab3c 1023
4884c50b
SM
1024 ;; First try the standard algorithm by looking into the .ali file, but if
1025 ;; that file was too old or even did not exist, try to look in the whole
1026 ;; object path for a possible location.
1027 (let ((identlist (ada-read-identifier pos)))
1028 (condition-case nil
1029 (ada-find-in-ali identlist other-frame)
93cdce20
SM
1030 (error
1031 (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist))))
1032
1033 ;; If the ALI file was up-to-date, then we probably have a predefined
1034 ;; entity, whose references are not given by GNAT
1035 (if (and (file-exists-p ali-file)
1036 (file-newer-than-file-p ali-file (ada-file-of identlist)))
1037 (message "No cross-reference found. It might be a predefined entity.")
1038
1039 ;; Else, look in every ALI file, except if the user doesn't want that
1040 (if ada-xref-search-with-egrep
1041 (ada-find-in-src-path identlist other-frame)
1042 (message "Cross-referencing information is not up-to-date. Please recompile.")
1043 )))))))
4884c50b
SM
1044
1045(defun ada-goto-declaration-other-frame (pos &optional other-frame)
eec3232e
GM
1046 "Display the declaration of the identifier around POS.
1047The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
797aab3c 1048 (interactive "d")
4884c50b 1049 (ada-goto-declaration pos t))
797aab3c 1050
15ea3b67
GM
1051(defun ada-remote (command)
1052 "Return the remote version of COMMAND, or COMMAND if remote_machine is nil."
1053 (let ((machine (ada-xref-get-project-field 'remote_machine)))
1054 (if (or (not machine) (string= machine ""))
1055 command
1056 (format "%s %s '(%s)'"
1057 remote-shell-program
1058 machine
1059 command))))
1060
15ea3b67
GM
1061(defun ada-get-absolute-dir-list (dir-list root-dir)
1062 "Returns the list of absolute directories found in dir-list.
1063If a directory is a relative directory, the value of ROOT-DIR is added in
1064front."
4884c50b 1065 (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
15ea3b67
GM
1066
1067(defun ada-set-environment ()
1068 "Return the new value for process-environment.
1069It modifies the source path and object path with the values found in the
1070project file."
1071 (let ((include (getenv "ADA_INCLUDE_PATH"))
1072 (objects (getenv "ADA_OBJECTS_PATH"))
1073 (build-dir (ada-xref-get-project-field 'build_dir)))
1074 (if include
4884c50b 1075 (set 'include (concat path-separator include)))
15ea3b67 1076 (if objects
4884c50b 1077 (set 'objects (concat path-separator objects)))
15ea3b67
GM
1078 (cons
1079 (concat "ADA_INCLUDE_PATH="
4884c50b 1080 (mapconcat (lambda(x) (expand-file-name x build-dir))
15ea3b67 1081 (ada-xref-get-project-field 'src_dir)
4884c50b
SM
1082 path-separator)
1083 include)
15ea3b67
GM
1084 (cons
1085 (concat "ADA_OBJECTS_PATH="
4884c50b 1086 (mapconcat (lambda(x) (expand-file-name x build-dir))
15ea3b67 1087 (ada-xref-get-project-field 'obj_dir)
4884c50b
SM
1088 path-separator)
1089 objects)
15ea3b67
GM
1090 process-environment))))
1091
1092(defun ada-compile-application (&optional arg)
1093 "Compiles the application, using the command found in the project file.
1094If ARG is not nil, ask for user confirmation."
1095 (interactive "P")
797aab3c 1096 (ada-require-project-file)
15ea3b67
GM
1097 (let ((cmd (ada-xref-get-project-field 'make_cmd))
1098 (process-environment (ada-set-environment))
1099 (compilation-scroll-output t))
1100
4884c50b 1101 (setq compilation-search-path (ada-xref-get-src-dir-field))
15ea3b67
GM
1102
1103 ;; If no project file was found, ask the user
1104 (unless cmd
4884c50b 1105 (setq cmd '("") arg t))
15ea3b67 1106
4884c50b
SM
1107 ;; Make a single command from the list of commands, including the
1108 ;; commands to run it on a remote machine.
1109 (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
a1506d29 1110
4884c50b
SM
1111 (if (or ada-xref-confirm-compile arg)
1112 (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1113
1114 ;; Insert newlines so as to separate the name of the commands to run
1115 ;; and the output of the commands. this doesn't work with cmdproxy.exe,
1116 ;; which gets confused by newline characters.
c94ca9e0 1117 (if (not (string-match ".exe" shell-file-name))
4884c50b 1118 (setq cmd (concat cmd "\n\n")))
a1506d29 1119
4884c50b 1120 (compile (ada-quote-cmd cmd))))
797aab3c 1121
15ea3b67
GM
1122(defun ada-compile-current (&optional arg prj-field)
1123 "Recompile the current file.
1124If ARG is not nil, ask for user confirmation of the command.
1125PRJ-FIELD is the name of the field to use in the project file to get the
1126command, and should be either comp_cmd (default) or check_cmd."
1127 (interactive "P")
797aab3c 1128 (ada-require-project-file)
15ea3b67
GM
1129 (let* ((field (if prj-field prj-field 'comp_cmd))
1130 (cmd (ada-xref-get-project-field field))
1131 (process-environment (ada-set-environment))
1132 (compilation-scroll-output t))
a1506d29 1133
4884c50b 1134 (setq compilation-search-path (ada-xref-get-src-dir-field))
15ea3b67 1135
4884c50b
SM
1136 (unless cmd
1137 (setq cmd '("") arg t))
a1506d29 1138
4884c50b
SM
1139 ;; Make a single command from the list of commands, including the
1140 ;; commands to run it on a remote machine.
1141 (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
a1506d29 1142
15ea3b67 1143 ;; If no project file was found, ask the user
4884c50b
SM
1144 (if (or ada-xref-confirm-compile arg)
1145 (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1146
1147 ;; Insert newlines so as to separate the name of the commands to run
1148 ;; and the output of the commands. this doesn't work with cmdproxy.exe,
1149 ;; which gets confused by newline characters.
c94ca9e0 1150 (if (not (string-match ".exe" shell-file-name))
4884c50b 1151 (setq cmd (concat cmd "\n\n")))
a1506d29 1152
4884c50b 1153 (compile (ada-quote-cmd cmd))))
15ea3b67
GM
1154
1155(defun ada-check-current (&optional arg)
1156 "Recompile the current file.
1157If ARG is not nil, ask for user confirmation of the command."
1158 (interactive "P")
1159 (ada-compile-current arg 'check_cmd))
797aab3c 1160
15ea3b67
GM
1161(defun ada-run-application (&optional arg)
1162 "Run the application.
1163if ARG is not-nil, asks for user confirmation."
797aab3c
GM
1164 (interactive)
1165 (ada-require-project-file)
1166
15ea3b67
GM
1167 (let ((machine (ada-xref-get-project-field 'cross_prefix)))
1168 (if (and machine (not (string= machine "")))
1169 (error "This feature is not supported yet for cross environments")))
797aab3c 1170
15ea3b67 1171 (let ((command (ada-xref-get-project-field 'run_cmd)))
797aab3c 1172
15ea3b67 1173 ;; Guess the command if it wasn't specified
4884c50b
SM
1174 (if (not command)
1175 (set 'command (list (file-name-sans-extension (buffer-name)))))
797aab3c 1176
4884c50b
SM
1177 ;; Modify the command to run remotely
1178 (setq command (ada-remote (mapconcat 'identity command
1179 ada-command-separator)))
a1506d29 1180
15ea3b67
GM
1181 ;; Ask for the arguments to the command if required
1182 (if (or ada-xref-confirm-compile arg)
4884c50b
SM
1183 (setq command (read-from-minibuffer "Enter command to execute: "
1184 command)))
797aab3c
GM
1185
1186 ;; Run the command
1187 (save-excursion
1188 (set-buffer (get-buffer-create "*run*"))
15ea3b67 1189 (set 'buffer-read-only nil)
4884c50b 1190
15ea3b67 1191 (erase-buffer)
4884c50b
SM
1192 (start-process "run" (current-buffer) shell-file-name
1193 "-c" command)
1194 (comint-mode)
1195 ;; Set these two variables to their default values, since otherwise
1196 ;; the output buffer is scrolled so that only the last output line
1197 ;; is visible at the top of the buffer.
1198 (set (make-local-variable 'scroll-step) 0)
1199 (set (make-local-variable 'scroll-conservatively) 0)
797aab3c
GM
1200 )
1201 (display-buffer "*run*")
1202
1203 ;; change to buffer *run* for interactive programs
1204 (other-window 1)
1205 (switch-to-buffer "*run*")
15ea3b67 1206 ))
797aab3c 1207
4884c50b 1208(defun ada-gdb-application (&optional arg executable-name)
15ea3b67 1209 "Start the debugger on the application.
4884c50b
SM
1210EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the
1211project file.
15ea3b67
GM
1212If ARG is non-nil, ask the user to confirm the command."
1213 (interactive "P")
797aab3c 1214 (let ((buffer (current-buffer))
4884c50b 1215 cmd pre-cmd post-cmd)
797aab3c 1216 (ada-require-project-file)
4884c50b
SM
1217 (setq cmd (if executable-name
1218 (concat ada-prj-default-debugger " " executable-name)
1219 (ada-xref-get-project-field 'debug_cmd))
1220 pre-cmd (ada-xref-get-project-field 'debug_pre_cmd)
1221 post-cmd (ada-xref-get-project-field 'debug_post_cmd))
15ea3b67
GM
1222
1223 ;; If the command was not given in the project file, start a bare gdb
1224 (if (not cmd)
1225 (set 'cmd (concat ada-prj-default-debugger
1226 " "
4884c50b
SM
1227 (or executable-name
1228 (file-name-sans-extension (buffer-file-name))))))
1229
1230 ;; For gvd, add an extra switch so that the Emacs window is completly
1231 ;; swallowed inside the Gvd one
1232 (if (and ada-tight-gvd-integration
1233 (string-match "^[^ \t]*gvd" cmd))
1234 ;; Start a new frame, so that when gvd exists we do not kill Emacs
1235 ;; We make sure that gvd swallows the new frame, not the one the
1236 ;; user has been using until now
1237 ;; The frame is made invisible initially, so that GtkPlug gets a
1238 ;; chance to fully manage it. Then it works fine with Enlightenment
1239 ;; as well
1240 (let ((frame (make-frame '((visibility . nil)))))
1241 (set 'cmd (concat
1242 cmd " --editor-window="
1243 (cdr (assoc 'outer-window-id (frame-parameters frame)))))
1244 (select-frame frame)))
1245
1246 ;; Add a -fullname switch
1247 ;; Use the remote machine
1248 (set 'cmd (ada-remote (concat cmd " -fullname ")))
1249
1250 ;; Ask for confirmation if required
15ea3b67
GM
1251 (if (or arg ada-xref-confirm-compile)
1252 (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
1253
c94ca9e0
JB
1254 (let ((old-comint-exec (symbol-function 'comint-exec))
1255 comint-exec
4884c50b
SM
1256 in-post-mode
1257 gud-gdb-massage-args)
1258
1259 ;; Do not add -fullname, since we can have a 'rsh' command in front.
1260 (fset 'gud-gdb-massage-args (lambda (file args) args))
1261
1262 (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
1263 (if (not (equal pre-cmd ""))
1264 (setq pre-cmd (concat pre-cmd ada-command-separator)))
1265
1266 (set 'post-cmd (mapconcat 'identity post-cmd "\n"))
1267 (if post-cmd
1268 (set 'post-cmd (concat post-cmd "\n")))
1269
c94ca9e0 1270
4884c50b
SM
1271 ;; Temporarily replaces the definition of `comint-exec' so that we
1272 ;; can execute commands before running gdb.
c94ca9e0 1273 (make-local-variable 'comint-exec)
a1506d29 1274 (fset 'comint-exec
4884c50b
SM
1275 `(lambda (buffer name command startfile switches)
1276 (let (compilation-buffer-name-function)
1277 (save-excursion
1278 (set 'compilation-buffer-name-function
1279 (lambda(x) (buffer-name buffer)))
1280 (compile (ada-quote-cmd
1281 (concat ,pre-cmd
1282 command " "
1283 (mapconcat 'identity switches " "))))))
1284 ))
1285
1286 ;; Tight integration should force the tty mode
1287 (if (and (string-match "gvd" (comint-arguments cmd 0 0))
1288 ada-tight-gvd-integration
1289 (not (string-match "--tty" cmd)))
1290 (setq cmd (concat cmd "--tty")))
a1506d29 1291
4884c50b
SM
1292 (if (and (string-match "jdb" (comint-arguments cmd 0 0))
1293 (boundp 'jdb))
1294 (funcall (symbol-function 'jdb) cmd)
1295 (gdb cmd))
1296
c94ca9e0
JB
1297 ;; Restore the standard fset command (or for instance C-U M-x shell
1298 ;; wouldn't work anymore
1299
1300 (fset 'comint-exec old-comint-exec)
1301
4884c50b
SM
1302 ;; Send post-commands to the debugger
1303 (process-send-string (get-buffer-process (current-buffer)) post-cmd)
1304
1305 ;; Move to the end of the debugger buffer, so that it is automatically
1306 ;; scrolled from then on.
1307 (end-of-buffer)
1308
1309 ;; Display both the source window and the debugger window (the former
1310 ;; above the latter). No need to show the debugger window unless it
1311 ;; is going to have some relevant information.
1312 (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
1313 (string-match "--tty" cmd))
1314 (split-window-vertically))
1315 (switch-to-buffer buffer)
1316 )))
797aab3c
GM
1317
1318
15ea3b67
GM
1319(defun ada-reread-prj-file (&optional filename)
1320 "Forces Emacs to read either FILENAME or the project file associated
1321with the current buffer.
1322Otherwise, this file is only read once, and never read again.
1323Since the information in the project file is shared between all buffers, this
1324automatically modifies the setup for all the Ada buffer that use this file."
797aab3c 1325 (interactive "P")
15ea3b67
GM
1326 (if filename
1327 (ada-parse-prj-file filename)
797aab3c 1328 (ada-parse-prj-file (ada-prj-find-prj-file)))
797aab3c 1329
4884c50b
SM
1330 ;; Reread the location of the standard runtime library
1331 (ada-initialize-runtime-library
c94ca9e0 1332 (or (ada-xref-get-project-field 'cross_prefix) ""))
4884c50b 1333 )
15ea3b67 1334
797aab3c
GM
1335;; ------ Private routines
1336
1337(defun ada-xref-current (file &optional ali-file-name)
eec3232e 1338 "Update the cross-references for FILE.
4884c50b
SM
1339This in fact recompiles FILE to create ALI-FILE-NAME.
1340This function returns the name of the file that was recompiled to generate
1341the cross-reference information. Note that the ali file can then be deduced by
1342replacing the file extension with .ali"
797aab3c
GM
1343 ;; kill old buffer
1344 (if (and ali-file-name
1345 (get-file-buffer ali-file-name))
1346 (kill-buffer (get-file-buffer ali-file-name)))
a1506d29 1347
4884c50b
SM
1348 (let* ((name (ada-convert-file-name file))
1349 (body-name (or (ada-get-body-name name) name)))
15ea3b67 1350
4884c50b
SM
1351 ;; Always recompile the body when we can. We thus temporarily switch to a
1352 ;; buffer than contains the body of the unit
1353 (save-excursion
1354 (let ((body-visible (find-buffer-visiting body-name))
1355 process)
1356 (if body-visible
1357 (set-buffer body-visible)
1358 (find-file body-name))
1359
1360 ;; Execute the compilation. Note that we must wait for the end of the
1361 ;; process, or the ALI file would still not be available.
1362 ;; Unfortunately, the underlying `compile' command that we use is
1363 ;; asynchronous.
1364 (ada-compile-current)
1365 (setq process (get-buffer-process "*compilation*"))
1366
1367 (while (and process
1368 (not (equal (process-status process) 'exit)))
1369 (sit-for 1))
1370
1371 ;; remove the buffer for the body if it wasn't there before
1372 (unless body-visible
1373 (kill-buffer (find-buffer-visiting body-name)))
1374 ))
1375 body-name))
15ea3b67
GM
1376
1377(defun ada-find-file-in-dir (file dir-list)
1378 "Search for FILE in DIR-LIST."
1379 (let (found)
1380 (while (and (not found) dir-list)
1381 (set 'found (concat (file-name-as-directory (car dir-list))
1382 (file-name-nondirectory file)))
a1506d29 1383
15ea3b67
GM
1384 (unless (file-exists-p found)
1385 (set 'found nil))
1386 (set 'dir-list (cdr dir-list)))
1387 found))
797aab3c
GM
1388
1389(defun ada-find-ali-file-in-dir (file)
15ea3b67
GM
1390 "Find an .ali file in obj_dir. The current buffer must be the Ada file.
1391Adds build_dir in front of the search path to conform to gnatmake's behavior,
1392and the standard runtime location at the end."
4884c50b 1393 (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
15ea3b67
GM
1394
1395(defun ada-find-src-file-in-dir (file)
1396 "Find a source file in src_dir. The current buffer must be the Ada file.
1397Adds src_dir in front of the search path to conform to gnatmake's behavior,
1398and the standard runtime location at the end."
4884c50b 1399 (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
797aab3c
GM
1400
1401(defun ada-get-ali-file-name (file)
eec3232e
GM
1402 "Create the ali file name for the ada-file FILE.
1403The file is searched for in every directory shown in the obj_dir lines of
1404the project file."
797aab3c
GM
1405
1406 ;; This function has to handle the special case of non-standard
1407 ;; file names (i.e. not .adb or .ads)
1408 ;; The trick is the following:
1409 ;; 1- replace the extension of the current file with .ali,
1410 ;; and look for this file
1411 ;; 2- If this file is found:
1412 ;; grep the "^U" lines, and make sure we are not reading the
1413 ;; .ali file for a spec file. If we are, go to step 3.
1414 ;; 3- If the file is not found or step 2 failed:
1415 ;; find the name of the "other file", ie the body, and look
1416 ;; for its associated .ali file by subtituing the extension
4884c50b
SM
1417 ;;
1418 ;; We must also handle the case of separate packages and subprograms:
1419 ;; 4- If no ali file was found, we try to modify the file name by removing
1420 ;; everything after the last '-' or '.' character, so as to get the
1421 ;; ali file for the parent unit. If we found an ali file, we check that
1422 ;; it indeed contains the definition for the separate entity by checking
1423 ;; the 'D' lines. This is done repeatedly, in case the direct parent is
1424 ;; also a separate.
797aab3c
GM
1425
1426 (save-excursion
1427 (set-buffer (get-file-buffer file))
1428 (let ((short-ali-file-name
1429 (concat (file-name-sans-extension (file-name-nondirectory file))
1430 ".ali"))
4884c50b
SM
1431 ali-file-name
1432 is-spec)
1433
1434 ;; If we have a non-standard file name, and this is a spec, we first
1435 ;; look for the .ali file of the body, since this is the one that
1436 ;; contains the most complete information. If not found, we will do what
1437 ;; we can with the .ali file for the spec...
1438
1439 (if (not (string= (file-name-extension file) "ads"))
1440 (let ((specs ada-spec-suffixes))
1441 (while specs
1442 (if (string-match (concat (regexp-quote (car specs)) "$")
1443 file)
1444 (set 'is-spec t))
1445 (set 'specs (cdr specs)))))
1446
1447 (if is-spec
1448 (set 'ali-file-name
1449 (ada-find-ali-file-in-dir
1450 (concat (file-name-sans-extension
1451 (file-name-nondirectory
1452 (ada-other-file-name)))
1453 ".ali"))))
a1506d29 1454
4884c50b
SM
1455
1456 (setq ali-file-name
1457 (or ali-file-name
a1506d29 1458
4884c50b
SM
1459 ;; Else we take the .ali file associated with the unit
1460 (ada-find-ali-file-in-dir short-ali-file-name)
a1506d29 1461
4884c50b
SM
1462
1463 ;; else we did not find the .ali file Second chance: in case
1464 ;; the files do not have standard names (such as for instance
1465 ;; file_s.ada and file_b.ada), try to go to the other file
1466 ;; and look for its ali file
1467 (ada-find-ali-file-in-dir
1468 (concat (file-name-sans-extension
1469 (file-name-nondirectory (ada-other-file-name)))
1470 ".ali"))
1471
a1506d29 1472
4884c50b
SM
1473 ;; If we still don't have an ali file, try to get the one
1474 ;; from the parent unit, in case we have a separate entity.
1475 (let ((parent-name (file-name-sans-extension
1476 (file-name-nondirectory file))))
a1506d29 1477
4884c50b
SM
1478 (while (and (not ali-file-name)
1479 (string-match "^\\(.*\\)[.-][^.-]*" parent-name))
a1506d29 1480
4884c50b
SM
1481 (set 'parent-name (match-string 1 parent-name))
1482 (set 'ali-file-name (ada-find-ali-file-in-dir
1483 (concat parent-name ".ali")))
1484 )
1485 ali-file-name)))
a1506d29 1486
4884c50b
SM
1487 ;; If still not found, try to recompile the file
1488 (if (not ali-file-name)
1489 ;; recompile only if the user asked for this. and search the ali
1490 ;; filename again. We avoid a possible infinite recursion by
1491 ;; temporarily disabling the automatic compilation.
a1506d29 1492
4884c50b
SM
1493 (if ada-xref-create-ali
1494 (setq ali-file-name
1495 (concat (file-name-sans-extension (ada-xref-current file))
1496 ".ali"))
797aab3c 1497
4884c50b 1498 (error "Ali file not found. Recompile your file"))
a1506d29
JB
1499
1500
4884c50b
SM
1501 ;; same if the .ali file is too old and we must recompile it
1502 (if (and (file-newer-than-file-p file ali-file-name)
1503 ada-xref-create-ali)
1504 (ada-xref-current file ali-file-name)))
797aab3c 1505
4884c50b 1506 ;; Always return the correct absolute file name
797aab3c 1507 (expand-file-name ali-file-name))
4884c50b 1508 ))
797aab3c
GM
1509
1510(defun ada-get-ada-file-name (file original-file)
eec3232e
GM
1511 "Create the complete file name (+directory) for FILE.
1512The original file (where the user was) is ORIGINAL-FILE. Search in project
1513file for possible paths."
797aab3c
GM
1514
1515 (save-excursion
15ea3b67
GM
1516
1517 ;; If the buffer for original-file, use it to get the values from the
1518 ;; project file, otherwise load the file and its project file
1519 (let ((buffer (get-file-buffer original-file)))
1520 (if buffer
1521 (set-buffer buffer)
1522 (find-file original-file)
1523 (ada-require-project-file)))
a1506d29 1524
797aab3c
GM
1525 ;; we choose the first possible completion and we
1526 ;; return the absolute file name
15ea3b67 1527 (let ((filename (ada-find-src-file-in-dir file)))
797aab3c
GM
1528 (if filename
1529 (expand-file-name filename)
1530 (error (concat
1531 (file-name-nondirectory file)
1532 " not found in src_dir. Please check your project file")))
1533
1534 )))
1535
1536(defun ada-find-file-number-in-ali (file)
eec3232e 1537 "Returns the file number for FILE in the associated ali file."
797aab3c
GM
1538 (set-buffer (ada-get-ali-buffer file))
1539 (goto-char (point-min))
1540
1541 (let ((begin (re-search-forward "^D")))
1542 (beginning-of-line)
1543 (re-search-forward (concat "^D " (file-name-nondirectory file)))
1544 (count-lines begin (point))))
1545
1546(defun ada-read-identifier (pos)
4884c50b
SM
1547 "Returns the identlist around POS and switch to the .ali buffer.
1548The returned list represents the entity, and can be manipulated through the
1549macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
797aab3c
GM
1550
1551 ;; If at end of buffer (e.g the buffer is empty), error
1552 (if (>= (point) (point-max))
1553 (error "No identifier on point"))
a1506d29 1554
797aab3c
GM
1555 ;; goto first character of the identifier/operator (skip backward < and >
1556 ;; since they are part of multiple character operators
1557 (goto-char pos)
1558 (skip-chars-backward "a-zA-Z0-9_<>")
1559
1560 ;; check if it really is an identifier
1561 (if (ada-in-comment-p)
1562 (error "Inside comment"))
1563
1564 (let (identifier identlist)
1565 ;; Just in front of a string => we could have an operator declaration,
1566 ;; as in "+", "-", ..
1567 (if (= (char-after) ?\")
1568 (forward-char 1))
1569
1570 ;; if looking at an operator
15ea3b67
GM
1571 ;; This is only true if:
1572 ;; - the symbol is +, -, ...
1573 ;; - the symbol is made of letters, and not followed by _ or a letter
1574 (if (and (looking-at ada-operator-re)
1575 (or (not (= (char-syntax (char-after)) ?w))
1576 (not (or (= (char-syntax (char-after (match-end 0))) ?w)
1577 (= (char-after (match-end 0)) ?_)))))
797aab3c
GM
1578 (progn
1579 (if (and (= (char-before) ?\")
1580 (= (char-after (+ (length (match-string 0)) (point))) ?\"))
1581 (forward-char -1))
15ea3b67 1582 (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
797aab3c
GM
1583
1584 (if (ada-in-string-p)
1585 (error "Inside string or character constant"))
1586 (if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
1587 (error "No cross-reference available for reserved keyword"))
1588 (if (looking-at "[a-zA-Z0-9_]+")
1589 (set 'identifier (match-string 0))
1590 (error "No identifier around")))
a1506d29 1591
797aab3c
GM
1592 ;; Build the identlist
1593 (set 'identlist (ada-make-identlist))
1594 (ada-set-name identlist (downcase identifier))
1595 (ada-set-line identlist
93cdce20 1596 (number-to-string (count-lines 1 (point))))
797aab3c
GM
1597 (ada-set-column identlist
1598 (number-to-string (1+ (current-column))))
1599 (ada-set-file identlist (buffer-file-name))
1600 identlist
1601 ))
1602
1603(defun ada-get-all-references (identlist)
15ea3b67 1604 "Completes and returns IDENTLIST with the information extracted
eec3232e 1605from the ali file (definition file and places where it is referenced)."
a1506d29 1606
797aab3c
GM
1607 (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
1608 declaration-found)
1609 (set-buffer ali-buffer)
1610 (goto-char (point-min))
1611 (ada-set-on-declaration identlist nil)
1612
1613 ;; First attempt: we might already be on the declaration of the identifier
1614 ;; We want to look for the declaration only in a definite interval (after
1615 ;; the "^X ..." line for the current file, and before the next "^X" line
a1506d29 1616
797aab3c
GM
1617 (if (re-search-forward
1618 (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
1619 nil t)
1620 (let ((bound (save-excursion (re-search-forward "^X " nil t))))
1621 (set 'declaration-found
1622 (re-search-forward
1623 (concat "^" (ada-line-of identlist)
1624 "." (ada-column-of identlist)
15ea3b67 1625 "[ *]" (ada-name-of identlist)
93cdce20 1626 "[{\(<= ]?\\(.*\\)$") bound t))
797aab3c
GM
1627 (if declaration-found
1628 (ada-set-on-declaration identlist t))
1629 ))
1630
1631 ;; If declaration is still nil, then we were not on a declaration, and
1632 ;; have to fall back on other algorithms
1633
1634 (unless declaration-found
a1506d29 1635
797aab3c
GM
1636 ;; Since we alread know the number of the file, search for a direct
1637 ;; reference to it
1638 (goto-char (point-min))
1639 (set 'declaration-found t)
1640 (ada-set-ali-index
1641 identlist
1642 (number-to-string (ada-find-file-number-in-ali
1643 (ada-file-of identlist))))
1644 (unless (re-search-forward (concat (ada-ali-index-of identlist)
93cdce20 1645 "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*"
797aab3c 1646 (ada-line-of identlist)
c94ca9e0 1647 "[^etpzkd<>=^]"
93cdce20 1648 (ada-column-of identlist) "\\>")
797aab3c
GM
1649 nil t)
1650
1651 ;; if we did not find it, it may be because the first reference
1652 ;; is not required to have a 'unit_number|' item included.
1653 ;; Or maybe we are already on the declaration...
4884c50b
SM
1654 (unless (re-search-forward
1655 (concat
93cdce20
SM
1656 "^[0-9]+.[0-9]+[ *]"
1657 (ada-name-of identlist)
1658 "[ <{=\(]\\(.\\|\n\\.\\)*\\<"
4884c50b
SM
1659 (ada-line-of identlist)
1660 "[^0-9]"
93cdce20 1661 (ada-column-of identlist) "\\>")
4884c50b 1662 nil t)
a1506d29 1663
797aab3c
GM
1664 ;; If still not found, then either the declaration is unknown
1665 ;; or the source file has been modified since the ali file was
1666 ;; created
1667 (set 'declaration-found nil)
1668 )
1669 )
1670
1671 ;; Last check to be completly sure we have found the correct line (the
1672 ;; ali might not be up to date for instance)
1673 (if declaration-found
1674 (progn
1675 (beginning-of-line)
1676 ;; while we have a continuation line, go up one line
1677 (while (looking-at "^\\.")
1678 (previous-line 1))
1679 (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
93cdce20 1680 (ada-name-of identlist) "[ <{=\(]"))
797aab3c
GM
1681 (set 'declaration-found nil))))
1682
1683 ;; Still no success ! The ali file must be too old, and we need to
1684 ;; use a basic algorithm based on guesses. Note that this only happens
1685 ;; if the user does not want us to automatically recompile files
1686 ;; automatically
1687 (unless declaration-found
15ea3b67
GM
1688 (if (ada-xref-find-in-modified-ali identlist)
1689 (set 'declaration-found t)
797aab3c
GM
1690 ;; no more idea to find the declaration. Give up
1691 (progn
1692 (kill-buffer ali-buffer)
1693 (error (concat "No declaration of " (ada-name-of identlist)
1694 " found."))
1695 )))
1696 )
1697
a1506d29 1698
797aab3c
GM
1699 ;; Now that we have found a suitable line in the .ali file, get the
1700 ;; information available
1701 (beginning-of-line)
1702 (if declaration-found
1703 (let ((current-line (buffer-substring
1704 (point) (save-excursion (end-of-line) (point)))))
1705 (save-excursion
1706 (next-line 1)
1707 (beginning-of-line)
1708 (while (looking-at "^\\.\\(.*\\)")
1709 (set 'current-line (concat current-line (match-string 1)))
1710 (next-line 1))
1711 )
1712
1713 (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
4884c50b
SM
1714
1715 ;; If we can find the file
1716 (condition-case err
1717 (ada-set-declare-file
1718 identlist
1719 (ada-get-ada-file-name (match-string 1)
1720 (ada-file-of identlist)))
a1506d29 1721
4884c50b
SM
1722 ;; Else clean up the ali file
1723 (error
1724 (kill-buffer ali-buffer)
1725 (error (error-message-string err)))
1726 ))
a1506d29 1727
797aab3c
GM
1728 (ada-set-references identlist current-line)
1729 ))
1730 ))
1731
1732(defun ada-xref-find-in-modified-ali (identlist)
1733 "Find the matching position for IDENTLIST in the current ali buffer.
1734This function is only called when the file was not up-to-date, so we need
1735to make some guesses.
eec3232e 1736This function is disabled for operators, and only works for identifiers."
797aab3c
GM
1737
1738 (unless (= (string-to-char (ada-name-of identlist)) ?\")
1739 (progn
1740 (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
1741 (my-regexp (concat "[ *]"
1742 (regexp-quote (ada-name-of identlist)) " "))
1743 (line-ada "--")
1744 (col-ada "--")
1745 (line-ali 0)
1746 (len 0)
15ea3b67
GM
1747 (choice 0)
1748 (ali-buffer (current-buffer)))
797aab3c
GM
1749
1750 (goto-char (point-max))
1751 (while (re-search-backward my-regexp nil t)
1752 (save-excursion
c94ca9e0 1753 (set 'line-ali (count-lines 1 (point)))
797aab3c
GM
1754 (beginning-of-line)
1755 ;; have a look at the line and column numbers
1756 (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
1757 (progn
1758 (setq line-ada (match-string 1))
1759 (setq col-ada (match-string 2)))
1760 (setq line-ada "--")
1761 (setq col-ada "--")
1762 )
1763 ;; construct a list with the file names and the positions within
1764 (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t)
1765 (add-to-list
1766 'declist (list line-ali (match-string 1) line-ada col-ada))
1767 )
1768 )
1769 )
1770
1771 ;; how many possible declarations have we found ?
1772 (setq len (length declist))
1773 (cond
1774 ;; none => error
1775 ((= len 0)
1776 (kill-buffer (current-buffer))
1777 (error (concat "No declaration of "
1778 (ada-name-of identlist)
1779 " recorded in .ali file")))
a1506d29 1780
797aab3c
GM
1781 ;; one => should be the right one
1782 ((= len 1)
1783 (goto-line (caar declist)))
a1506d29 1784
797aab3c
GM
1785 ;; more than one => display choice list
1786 (t
4884c50b
SM
1787 (save-window-excursion
1788 (with-output-to-temp-buffer "*choice list*"
a1506d29 1789
4884c50b
SM
1790 (princ "Identifier is overloaded and Xref information is not up to date.\n")
1791 (princ "Possible declarations are:\n\n")
1792 (princ " no. in file at line col\n")
1793 (princ " --- --------------------- ---- ----\n")
1794 (let ((counter 0))
1795 (while (< counter len)
1796 (princ (format " %2d) %-21s %4s %4s\n"
1797 (1+ counter)
797aab3c 1798 (ada-get-ada-file-name
4884c50b 1799 (nth 1 (nth counter declist))
797aab3c 1800 (ada-file-of identlist))
4884c50b
SM
1801 (nth 2 (nth counter declist))
1802 (nth 3 (nth counter declist))
797aab3c 1803 ))
4884c50b
SM
1804 (setq counter (1+ counter))
1805 ) ; end of while
1806 ) ; end of let
1807 ) ; end of with-output-to ...
1808 (setq choice nil)
1809 (while (or
1810 (not choice)
1811 (not (integerp choice))
1812 (< choice 1)
1813 (> choice len))
1814 (setq choice
1815 (string-to-int
1816 (read-from-minibuffer "Enter No. of your choice: "))))
1817 )
15ea3b67 1818 (set-buffer ali-buffer)
797aab3c
GM
1819 (goto-line (car (nth (1- choice) declist)))
1820 ))))))
1821
1822
1823(defun ada-find-in-ali (identlist &optional other-frame)
eec3232e
GM
1824 "Look in the .ali file for the definition of the identifier in IDENTLIST.
1825If OTHER-FRAME is non nil, and `ada-xref-other-buffer' is non nil,
1826opens a new window to show the declaration."
797aab3c
GM
1827
1828 (ada-get-all-references identlist)
1829 (let ((ali-line (ada-references-of identlist))
4884c50b
SM
1830 (locations nil)
1831 (start 0)
797aab3c 1832 file line col)
4884c50b
SM
1833
1834 ;; Note: in some cases, an entity can have multiple references to the
1835 ;; bodies (this is for instance the case for a separate subprogram, that
1836 ;; has a reference both to the stub and to the real body).
1837 ;; In that case, we simply go to each one in turn.
1838
1839 ;; Get all the possible locations
1840 (string-match "^\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line)
1841 (set 'locations (list (list (match-string 1 ali-line) ;; line
1842 (match-string 2 ali-line) ;; column
1843 (ada-declare-file-of identlist))))
c94ca9e0
JB
1844 (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)"
1845 ali-line start)
4884c50b 1846 (setq line (match-string 1 ali-line)
c94ca9e0
JB
1847 col (match-string 3 ali-line)
1848 start (match-end 3))
4884c50b
SM
1849
1850 ;; it there was a file number in the same line
c94ca9e0 1851 (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?"
4884c50b
SM
1852 (match-string 0 ali-line))
1853 ali-line)
1854 (let ((file-number (match-string 1 ali-line)))
1855 (goto-char (point-min))
1856 (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
1857 (string-to-number file-number))
1858 (set 'file (match-string 1))
1859 )
1860 ;; Else get the nearest file
1861 (set 'file (ada-declare-file-of identlist)))
a1506d29 1862
4884c50b
SM
1863 (set 'locations (append locations (list (list line col file)))))
1864
1865 ;; Add the specs at the end again, so that from the last body we go to
1866 ;; the specs
1867 (set 'locations (append locations (list (car locations))))
1868
1869 ;; Find the new location we want to go to.
1870 ;; If we are on none of the locations listed, we simply go to the specs.
1871
1872 (setq line (caar locations)
1873 col (nth 1 (car locations))
1874 file (nth 2 (car locations)))
a1506d29 1875
4884c50b
SM
1876 (while locations
1877 (if (and (string= (caar locations) (ada-line-of identlist))
1878 (string= (nth 1 (car locations)) (ada-column-of identlist))
1879 (string= (file-name-nondirectory (nth 2 (car locations)))
1880 (file-name-nondirectory (ada-file-of identlist))))
1881 (setq locations (cadr locations)
1882 line (car locations)
1883 col (nth 1 locations)
1884 file (nth 2 locations)
1885 locations nil)
1886 (set 'locations (cdr locations))))
1887
1888 ;; Find the file in the source path
1889 (set 'file (ada-get-ada-file-name file (ada-file-of identlist)))
1890
1891 ;; Kill the .ali buffer
1892 (kill-buffer (current-buffer))
797aab3c
GM
1893
1894 ;; Now go to the buffer
4884c50b
SM
1895 (ada-xref-change-buffer file
1896 (string-to-number line)
1897 (1- (string-to-number col))
1898 identlist
1899 other-frame)
797aab3c
GM
1900 ))
1901
4884c50b
SM
1902(defun ada-find-in-src-path (identlist &optional other-frame)
1903 "More general function for cross-references.
1904This function should be used when the standard algorithm that parses the
1905.ali file has failed, either because that file was too old or even did not
1906exist.
1907This function attempts to find the possible declarations for the identifier
1908anywhere in the object path.
1909This command requires the external `egrep' program to be available.
1910
1911This works well when one is using an external librarie and wants
1912to find the declaration and documentation of the subprograms one is
1913is using."
a1506d29 1914
4884c50b
SM
1915 (let (list
1916 (dirs (ada-xref-get-obj-dir-field))
1917 (regexp (concat "[ *]" (ada-name-of identlist)))
1918 line column
1919 choice
1920 file)
a1506d29 1921
4884c50b 1922 (save-excursion
a1506d29 1923
4884c50b
SM
1924 ;; Do the grep in all the directories. We do multiple shell
1925 ;; commands instead of one in case there is no .ali file in one
1926 ;; of the directory and the shell stops because of that.
a1506d29 1927
4884c50b
SM
1928 (set-buffer (get-buffer-create "*grep*"))
1929 (while dirs
1930 (insert (shell-command-to-string
1931 (concat "egrep -i -h '^X|" regexp "( |$)' "
1932 (file-name-as-directory (car dirs)) "*.ali")))
1933 (set 'dirs (cdr dirs)))
a1506d29 1934
4884c50b
SM
1935 ;; Now parse the output
1936 (set 'case-fold-search t)
1937 (goto-char (point-min))
1938 (while (re-search-forward regexp nil t)
1939 (save-excursion
1940 (beginning-of-line)
1941 (if (not (= (char-after) ?X))
1942 (progn
1943 (looking-at "\\([0-9]+\\).\\([0-9]+\\)")
1944 (setq line (match-string 1)
1945 column (match-string 2))
1946 (re-search-backward "^X [0-9]+ \\(.*\\)$")
1947 (set 'file (list (match-string 1) line column))
a1506d29 1948
4884c50b
SM
1949 ;; There could be duplicate choices, because of the structure
1950 ;; of the .ali files
1951 (unless (member file list)
1952 (set 'list (append list (list file))))))))
a1506d29 1953
4884c50b
SM
1954 ;; Current buffer is still "*grep*"
1955 (kill-buffer "*grep*")
1956 )
a1506d29 1957
4884c50b
SM
1958 ;; Now display the list of possible matches
1959 (cond
a1506d29 1960
4884c50b
SM
1961 ;; No choice found => Error
1962 ((null list)
1963 (error "No cross-reference found, please recompile your file"))
a1506d29 1964
4884c50b
SM
1965 ;; Only one choice => Do the cross-reference
1966 ((= (length list) 1)
1967 (set 'file (ada-find-src-file-in-dir (caar list)))
1968 (if file
1969 (ada-xref-change-buffer file
1970 (string-to-number (nth 1 (car list)))
1971 (string-to-number (nth 2 (car list)))
1972 identlist
1973 other-frame)
1974 (error (concat (caar list) " not found in src_dir")))
1975 (message "This is only a (good) guess at the cross-reference.")
1976 )
a1506d29 1977
4884c50b
SM
1978 ;; Else, ask the user
1979 (t
1980 (save-window-excursion
1981 (with-output-to-temp-buffer "*choice list*"
a1506d29 1982
4884c50b
SM
1983 (princ "Identifier is overloaded and Xref information is not up to date.\n")
1984 (princ "Possible declarations are:\n\n")
1985 (princ " no. in file at line col\n")
1986 (princ " --- --------------------- ---- ----\n")
1987 (let ((counter 0))
1988 (while (< counter (length list))
1989 (princ (format " %2d) %-21s %4s %4s\n"
1990 (1+ counter)
1991 (nth 0 (nth counter list))
1992 (nth 1 (nth counter list))
1993 (nth 2 (nth counter list))
1994 ))
1995 (setq counter (1+ counter))
1996 )))
1997 (setq choice nil)
1998 (while (or (not choice)
1999 (not (integerp choice))
2000 (< choice 1)
2001 (> choice (length list)))
2002 (setq choice
2003 (string-to-int
2004 (read-from-minibuffer "Enter No. of your choice: "))))
2005 )
2006 (set 'choice (1- choice))
2007 (kill-buffer "*choice list*")
2008
2009 (set 'file (ada-find-src-file-in-dir (car (nth choice list))))
2010 (if file
2011 (ada-xref-change-buffer file
2012 (string-to-number (nth 1 (nth choice list)))
2013 (string-to-number (nth 2 (nth choice list)))
2014 identlist
2015 other-frame)
2016 (error (concat (car (nth choice list)) " not found in src_dir")))
2017 (message "This is only a (good) guess at the cross-reference.")
2018 ))))
2019
797aab3c
GM
2020(defun ada-xref-change-buffer
2021 (file line column identlist &optional other-frame)
4884c50b 2022 "Select and display FILE, at LINE and COLUMN.
797aab3c 2023If we do not end on the same identifier as IDENTLIST, find the closest
eec3232e
GM
2024match. Kills the .ali buffer at the end.
2025If OTHER-FRAME is non-nil, creates a new frame to show the file."
797aab3c 2026
4884c50b 2027 (let (declaration-buffer)
797aab3c
GM
2028
2029 ;; Select and display the destination buffer
2030 (if ada-xref-other-buffer
2031 (if other-frame
2032 (find-file-other-frame file)
2033 (set 'declaration-buffer (find-file-noselect file))
2034 (set-buffer declaration-buffer)
2035 (switch-to-buffer-other-window declaration-buffer)
2036 )
2037 (find-file file)
2038 )
2039
797aab3c
GM
2040 ;; move the cursor to the correct position
2041 (push-mark)
2042 (goto-line line)
2043 (move-to-column column)
2044
2045 ;; If we are not on the identifier, the ali file was not up-to-date.
2046 ;; Try to find the nearest position where the identifier is found,
2047 ;; this is probably the right one.
2048 (unless (looking-at (ada-name-of identlist))
2049 (ada-xref-search-nearest (ada-name-of identlist)))
4884c50b 2050 ))
797aab3c
GM
2051
2052
2053(defun ada-xref-search-nearest (name)
2054 "Searches for NAME nearest to the position recorded in the Xref file.
2055It returns the position of the declaration in the buffer or nil if not found."
2056 (let ((orgpos (point))
2057 (newpos nil)
2058 (diff nil))
2059
2060 (goto-char (point-max))
2061
2062 ;; loop - look for all declarations of name in this file
2063 (while (search-backward name nil t)
2064
2065 ;; check if it really is a complete Ada identifier
2066 (if (and
2067 (not (save-excursion
2068 (goto-char (match-end 0))
2069 (looking-at "_")))
2070 (not (ada-in-string-or-comment-p))
2071 (or
2072 ;; variable declaration ?
2073 (save-excursion
2074 (skip-chars-forward "a-zA-Z_0-9" )
2075 (ada-goto-next-non-ws)
2076 (looking-at ":[^=]"))
2077 ;; procedure, function, task or package declaration ?
2078 (save-excursion
2079 (ada-goto-previous-word)
2080 (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]\\>"))))
2081
2082 ;; check if it is nearer than the ones before if any
2083 (if (or (not diff)
2084 (< (abs (- (point) orgpos)) diff))
2085 (progn
2086 (setq newpos (point)
2087 diff (abs (- newpos orgpos))))))
2088 )
2089
2090 (if newpos
2091 (progn
2092 (message "ATTENTION: this declaration is only a (good) guess ...")
2093 (goto-char newpos))
2094 nil)))
2095
2096
2097;; Find the parent library file of the current file
2098(defun ada-goto-parent ()
eec3232e 2099 "Go to the parent library file."
797aab3c
GM
2100 (interactive)
2101 (ada-require-project-file)
2102
2103 (let ((buffer (ada-get-ali-buffer (buffer-file-name)))
2104 (unit-name nil)
2105 (body-name nil)
2106 (ali-name nil))
2107 (save-excursion
2108 (set-buffer buffer)
2109 (goto-char (point-min))
2110 (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)")
2111 (setq unit-name (match-string 1))
2112 (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name))
2113 (progn
2114 (kill-buffer buffer)
2115 (error "No parent unit !"))
2116 (setq unit-name (match-string 1 unit-name))
2117 )
2118
2119 ;; look for the file name for the parent unit specification
2120 (goto-char (point-min))
2121 (re-search-forward (concat "^W " unit-name
2122 "%s[ \t]+\\([^ \t]+\\)[ \t]+"
2123 "\\([^ \t\n]+\\)"))
2124 (setq body-name (match-string 1))
2125 (setq ali-name (match-string 2))
2126 (kill-buffer buffer)
2127 )
2128
2129 (setq ali-name (ada-find-ali-file-in-dir ali-name))
2130
2131 (save-excursion
2132 ;; Tries to open the new ali file to find the spec file
2133 (if ali-name
2134 (progn
2135 (find-file ali-name)
2136 (goto-char (point-min))
2137 (re-search-forward (concat "^U " unit-name "%s[ \t]+"
2138 "\\([^ \t]+\\)"))
2139 (setq body-name (match-string 1))
2140 (kill-buffer (current-buffer))
2141 )
2142 )
2143 )
2144
2145 (find-file body-name)
2146 ))
2147
2148(defun ada-make-filename-from-adaname (adaname)
eec3232e
GM
2149 "Determine the filename in which ADANAME is found.
2150This is a GNAT specific function that uses gnatkrunch."
797aab3c
GM
2151 (let (krunch-buf)
2152 (setq krunch-buf (generate-new-buffer "*gkrunch*"))
2153 (save-excursion
2154 (set-buffer krunch-buf)
2155 ;; send adaname to external process `gnatkr'.
2156 (call-process "gnatkr" nil krunch-buf nil
2157 adaname ada-krunch-args)
2158 ;; fetch output of that process
2159 (setq adaname (buffer-substring
2160 (point-min)
2161 (progn
2162 (goto-char (point-min))
2163 (end-of-line)
2164 (point))))
2165 (kill-buffer krunch-buf)))
2166 adaname
2167 )
2168
797aab3c
GM
2169(defun ada-make-body-gnatstub ()
2170 "Create an Ada package body in the current buffer.
2171This function uses the `gnatstub' program to create the body.
2172This function typically is to be hooked into `ff-file-created-hooks'."
2173 (interactive)
2174
2175 (save-some-buffers nil nil)
2176
4884c50b
SM
2177 ;; If the current buffer is the body (as is the case when calling this
2178 ;; function from ff-file-created-hooks), then kill this temporary buffer
2179 (unless (interactive-p)
2180 (progn
2181 (set-buffer-modified-p nil)
2182 (kill-buffer (current-buffer))))
a1506d29 2183
797aab3c 2184
4884c50b
SM
2185 ;; Make sure the current buffer is the spec (this might not be the case
2186 ;; if for instance the user was asked for a project file)
2187
2188 (unless (buffer-file-name (car (buffer-list)))
2189 (set-buffer (cadr (buffer-list))))
2190
2191 ;; Make sure we have a project file (for parameters to gnatstub). Note that
2192 ;; this might have already been done if we have been called from the hook,
2193 ;; but this is not an expensive call)
2194 (ada-require-project-file)
797aab3c
GM
2195
2196 ;; Call the external process gnatstub
2197 (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
4884c50b 2198 (filename (buffer-file-name (car (buffer-list))))
797aab3c
GM
2199 (output (concat (file-name-sans-extension filename) ".adb"))
2200 (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename))
2201 (buffer (get-buffer-create "*gnatstub*")))
2202
2203 (save-excursion
2204 (set-buffer buffer)
2205 (compilation-minor-mode 1)
2206 (erase-buffer)
2207 (insert gnatstub-cmd)
2208 (newline)
2209 )
2210 ;; call gnatstub to create the body file
2211 (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
2212
2213 (if (save-excursion
2214 (set-buffer buffer)
2215 (goto-char (point-min))
2216 (search-forward "command not found" nil t))
2217 (progn
2218 (message "gnatstub was not found -- using the basic algorithm")
2219 (sleep-for 2)
2220 (kill-buffer buffer)
2221 (ada-make-body))
2222
2223 ;; Else clean up the output
2224
797aab3c
GM
2225 (if (file-exists-p output)
2226 (progn
2227 (find-file output)
2228 (kill-buffer buffer))
2229
2230 ;; display the error buffer
2231 (display-buffer buffer)
2232 )
2233 )))
2234
797aab3c 2235(defun ada-xref-initialize ()
fea24571
SM
2236 "Function called by `ada-mode-hook' to initialize the ada-xref.el package.
2237For instance, it creates the gnat-specific menus, sets some hooks for
797aab3c 2238find-file...."
fea24571 2239 ;; This should really be an `add-hook'. -stef
7abe197c 2240 (setq ff-file-created-hook 'ada-make-body-gnatstub)
797aab3c 2241
797aab3c
GM
2242 ;; Completion for file names in the mini buffer should ignore .ali files
2243 (add-to-list 'completion-ignored-extensions ".ali")
c94ca9e0
JB
2244
2245 (ada-xref-update-project-menu)
797aab3c
GM
2246 )
2247
2248
2249;; ----- Add to ada-mode-hook ---------------------------------------------
2250
4884c50b
SM
2251;; Use gvd or ddd as the default debugger if it was found
2252;; On windows, do not use the --tty switch for GVD, since this is
2253;; not supported. Actually, we do not use this on Unix either, since otherwise
2254;; there is no console window left in GVD, and people have to use the
2255;; Emacs one.
2256;; This must be done before initializing the Ada menu.
2257(if (ada-find-file-in-dir "gvd" exec-path)
2258 (set 'ada-prj-default-debugger "gvd ")
2259 (if (ada-find-file-in-dir "gvd.exe" exec-path)
2260 (set 'ada-prj-default-debugger "gvd ")
2261 (if (ada-find-file-in-dir "ddd" exec-path)
2262 (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
2263
797aab3c
GM
2264(add-hook 'ada-mode-hook 'ada-xref-initialize)
2265
15ea3b67 2266;; Initializes the cross references to the runtime library
4884c50b 2267(ada-initialize-runtime-library "")
15ea3b67
GM
2268
2269;; Add these standard directories to the search path
7abe197c 2270(set 'ada-search-directories-internal
15ea3b67
GM
2271 (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
2272 ada-search-directories))
2273
797aab3c
GM
2274(provide 'ada-xref)
2275
383d5bbb 2276;;; ada-xref.el ends here