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