aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuanma Barranquero2006-10-31 00:57:56 +0000
committerJuanma Barranquero2006-10-31 00:57:56 +0000
commit417451fe30b0e796ee4232160e97436e8412d013 (patch)
tree4b900c88ee6221ac6079817885e5dc5dc6497fa9
parentaa0b6932977826d7effb3e4509cf70fee33670bc (diff)
downloademacs-417451fe30b0e796ee4232160e97436e8412d013.tar.gz
emacs-417451fe30b0e796ee4232160e97436e8412d013.zip
(ada-compile-current): Don't add newlines to commands.
-rw-r--r--lisp/progmodes/ada-xref.el489
1 files changed, 234 insertions, 255 deletions
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index 05d2a8bf65b..ae65688a351 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -1,4 +1,4 @@
1;;; ada-xref.el --- for lookup and completion in Ada mode 1;; ada-xref.el --- for lookup and completion in Ada mode
2 2
3;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 3;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4;; 2004, 2005, 2006 Free Software Foundation, Inc. 4;; 2004, 2005, 2006 Free Software Foundation, Inc.
@@ -6,8 +6,7 @@
6;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> 6;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
7;; Rolf Ebert <ebert@inf.enst.fr> 7;; Rolf Ebert <ebert@inf.enst.fr>
8;; Emmanuel Briot <briot@gnat.com> 8;; Emmanuel Briot <briot@gnat.com>
9;; Maintainer: Emmanuel Briot <briot@gnat.com> 9;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
10;; Ada Core Technologies's version: Revision: 1.181
11;; Keywords: languages ada xref 10;; Keywords: languages ada xref
12 11
13;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
@@ -38,6 +37,10 @@
38 37
39;;; You need Emacs >= 20.2 to run this package 38;;; You need Emacs >= 20.2 to run this package
40 39
40
41;;; History:
42;;
43
41;;; Code: 44;;; Code:
42 45
43;; ----- Requirements ----------------------------------------------------- 46;; ----- Requirements -----------------------------------------------------
@@ -47,7 +50,7 @@
47(require 'find-file) 50(require 'find-file)
48(require 'ada-mode) 51(require 'ada-mode)
49 52
50;; ------ Use variables 53;; ------ User variables
51(defcustom ada-xref-other-buffer t 54(defcustom ada-xref-other-buffer t
52 "*If nil, always display the cross-references in the same buffer. 55 "*If nil, always display the cross-references in the same buffer.
53Otherwise create either a new buffer or a new frame." 56Otherwise create either a new buffer or a new frame."
@@ -59,7 +62,7 @@ If nil, the cross-reference mode never runs gcc."
59 :type 'boolean :group 'ada) 62 :type 'boolean :group 'ada)
60 63
61(defcustom ada-xref-confirm-compile nil 64(defcustom ada-xref-confirm-compile nil
62 "*If non-nil, ask for confirmation before compiling or running the application." 65 "*Non-nil means ask for confirmation before compiling or running the application."
63 :type 'boolean :group 'ada) 66 :type 'boolean :group 'ada)
64 67
65(defcustom ada-krunch-args "0" 68(defcustom ada-krunch-args "0"
@@ -105,26 +108,25 @@ The command `gnatfind' is used every time you choose the menu
105 (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" 108 (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
106 " ${comp_opt}") 109 " ${comp_opt}")
107 "*Default command to be used to compile a single file. 110 "*Default command to be used to compile a single file.
108Emacs will add the filename at the end of this command. This is the same 111Emacs will substitute the current filename for ${full_current}, or add
109syntax as in the project file." 112the filename at the end. This is the same syntax as in the project file."
110 :type 'string :group 'ada) 113 :type 'string :group 'ada)
111 114
112(defcustom ada-prj-default-debugger "${cross_prefix}gdb" 115(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
113 "*Default name of the debugger. We recommend either `gdb', 116 "*Default name of the debugger."
114`gdb --emacs_gdbtk' or `ddd --tty -fullname'."
115 :type 'string :group 'ada) 117 :type 'string :group 'ada)
116 118
117(defcustom ada-prj-default-make-cmd 119(defcustom ada-prj-default-make-cmd
118 (concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} " 120 (concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} "
119 "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}") 121 "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
120 "*Default command to be used to compile the application. 122 "*Default command to be used to compile the application.
121This is the same syntax as in the project file." 123This is the same syntax as in the project file."
122 :type 'string :group 'ada) 124 :type 'string :group 'ada)
123 125
124(defcustom ada-prj-default-project-file "" 126(defcustom ada-prj-default-project-file ""
125 "*Name of the project file to use for every Ada file. 127 "*Name of the current project file.
126Emacs will not try to use the standard algorithm to find the project file if 128Emacs will not try to use the search algorithm to find the project file if
127this string is not empty." 129this string is not empty. It is set whenever a project file is found."
128 :type '(file :must-match t) :group 'ada) 130 :type '(file :must-match t) :group 'ada)
129 131
130(defcustom ada-gnatstub-opts "-q -I${src_dir}" 132(defcustom ada-gnatstub-opts "-q -I${src_dir}"
@@ -238,7 +240,7 @@ As always, the values of the project file are defined through properties.")
238(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) 240(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
239 241
240(defsubst ada-get-ali-buffer (file) 242(defsubst ada-get-ali-buffer (file)
241 "Reads the ali file into a new buffer, and returns this buffer's name" 243 "Read the ali file FILE into a new buffer, and return the buffer's name."
242 (find-file-noselect (ada-get-ali-file-name file))) 244 (find-file-noselect (ada-get-ali-file-name file)))
243 245
244 246
@@ -250,7 +252,7 @@ As always, the values of the project file are defined through properties.")
250 252
251(defun ada-initialize-runtime-library (cross-prefix) 253(defun ada-initialize-runtime-library (cross-prefix)
252 "Initialize the variables for the runtime library location. 254 "Initialize the variables for the runtime library location.
253CROSS-PREFIX is the prefix to use for the gnatls command." 255CROSS-PREFIX is the prefix to use for the `gnatls' command."
254 (save-excursion 256 (save-excursion
255 (setq ada-xref-runtime-library-specs-path '() 257 (setq ada-xref-runtime-library-specs-path '()
256 ada-xref-runtime-library-ali-path '()) 258 ada-xref-runtime-library-ali-path '())
@@ -305,9 +307,9 @@ CROSS-PREFIX is the prefix to use for the gnatls command."
305 307
306(defun ada-treat-cmd-string (cmd-string) 308(defun ada-treat-cmd-string (cmd-string)
307 "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value. 309 "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
308The project file must have been loaded first. 310Assumes project exists.
309As a special case, ${current} is replaced with the name of the currently 311As a special case, ${current} is replaced with the name of the current
310edited file, minus extension but with directory, and ${full_current} is 312file, minus extension but with directory, and ${full_current} is
311replaced by the name including the extension." 313replaced by the name including the extension."
312 314
313 (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string) 315 (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)
@@ -349,9 +351,8 @@ replaced by the name including the extension."
349 (set-buffer ada-buffer) 351 (set-buffer ada-buffer)
350 352
351 (set 'plist 353 (set 'plist
352 ;; Try hard to find a default value for filename, so that the user 354 ;; Try hard to find a project file, even if the current
353 ;; can edit his project file even if the current buffer is not an 355 ;; buffer is not an Ada file or not associated with a file
354 ;; Ada file or not even associated with a file
355 (list 'filename (expand-file-name 356 (list 'filename (expand-file-name
356 (cond 357 (cond
357 (ada-prj-default-project-file 358 (ada-prj-default-project-file
@@ -403,8 +404,7 @@ replaced by the name including the extension."
403 404
404(defun ada-xref-get-project-field (field) 405(defun ada-xref-get-project-field (field)
405 "Extract the value of FIELD from the current project file. 406 "Extract the value of FIELD from the current project file.
406The project file must have been loaded first. 407Project variables are substituted.
407A default value is returned if the file was not found.
408 408
409Note that for src_dir and obj_dir, you should rather use 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 410`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in
@@ -443,7 +443,6 @@ addition return the default paths."
443 ) 443 )
444 )) 444 ))
445 445
446
447(defun ada-xref-get-src-dir-field () 446(defun ada-xref-get-src-dir-field ()
448 "Return the full value for src_dir, including the default directories. 447 "Return the full value for src_dir, including the default directories.
449All the directories are returned as absolute directories." 448All the directories are returned as absolute directories."
@@ -529,6 +528,7 @@ All the directories are returned as absolute directories."
529 "Completion function when reading a file from the minibuffer. 528 "Completion function when reading a file from the minibuffer.
530Completion is attempted in all the directories in the source path, as 529Completion is attempted in all the directories in the source path, as
531defined in the project file." 530defined in the project file."
531 ;; FIXME: doc arguments
532 (let (list 532 (let (list
533 (dirs (ada-xref-get-src-dir-field))) 533 (dirs (ada-xref-get-src-dir-field)))
534 534
@@ -547,7 +547,7 @@ defined in the project file."
547 547
548;;;###autoload 548;;;###autoload
549(defun ada-find-file (filename) 549(defun ada-find-file (filename)
550 "Open a file anywhere in the source path. 550 "Open FILENAME, from anywhere in the source path.
551Completion is available." 551Completion is available."
552 (interactive 552 (interactive
553 (list (completing-read "File: " 'ada-do-file-completion))) 553 (list (completing-read "File: " 'ada-do-file-completion)))
@@ -582,9 +582,10 @@ Completion is available."
582 (goto-char (car pos))))) 582 (goto-char (car pos)))))
583 583
584(defun ada-convert-file-name (name) 584(defun ada-convert-file-name (name)
585 "Converts from NAME to a name that can be used by the compilation commands. 585 "Convert 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." 586This is overriden on VMS to convert from VMS filenames to Unix filenames."
587 name) 587 name)
588;; FIXME: use convert-standard-filename instead
588 589
589(defun ada-set-default-project-file (name &optional keep-existing) 590(defun ada-set-default-project-file (name &optional keep-existing)
590 "Set the file whose name is NAME as the default project file. 591 "Set the file whose name is NAME as the default project file.
@@ -694,12 +695,12 @@ file. If none is set, return nil."
694 695
695 696
696(defun ada-parse-prj-file (prj-file) 697(defun ada-parse-prj-file (prj-file)
697 "Reads and parses the PRJ-FILE file if it was found. 698 "Read PRJ-FILE, set it as the active project."
698The current buffer should be the ada-file buffer." 699 ;; FIXME: doc nil, search, etc.
699 (if prj-file 700 (if prj-file
700 (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing 701 (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing
701 run_cmd debug_pre_cmd debug_post_cmd 702 run_cmd debug_pre_cmd debug_post_cmd
702 (ada-buffer (current-buffer))) 703 (ada-buffer (current-buffer)))
703 (setq prj-file (expand-file-name prj-file)) 704 (setq prj-file (expand-file-name prj-file))
704 705
705 ;; Set the project file as the active one. 706 ;; Set the project file as the active one.
@@ -728,6 +729,8 @@ The current buffer should be the ada-file buffer."
728 (while (not (eobp)) 729 (while (not (eobp))
729 (if (looking-at "^\\([^=]+\\)=\\(.*\\)") 730 (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
730 (cond 731 (cond
732 ;; fields that are lists or paths require special processing
733 ;; FIXME: strip trailing spaces
731 ((string= (match-string 1) "src_dir") 734 ((string= (match-string 1) "src_dir")
732 (add-to-list 'src_dir 735 (add-to-list 'src_dir
733 (file-name-as-directory (match-string 2)))) 736 (file-name-as-directory (match-string 2))))
@@ -753,6 +756,7 @@ The current buffer should be the ada-file buffer."
753 ((string= (match-string 1) "debug_post_cmd") 756 ((string= (match-string 1) "debug_post_cmd")
754 (add-to-list 'debug_post_cmd (match-string 2))) 757 (add-to-list 'debug_post_cmd (match-string 2)))
755 (t 758 (t
759 ;; any other field in the file is just copied
756 (set 'project (plist-put project (intern (match-string 1)) 760 (set 'project (plist-put project (intern (match-string 1))
757 (match-string 2)))))) 761 (match-string 2))))))
758 (forward-line 1)) 762 (forward-line 1))
@@ -783,20 +787,20 @@ The current buffer should be the ada-file buffer."
783 787
784 ;; Else the file wasn't readable (probably the default project). 788 ;; Else the file wasn't readable (probably the default project).
785 ;; We initialize it with the current environment variables. 789 ;; We initialize it with the current environment variables.
786 ;; We need to add the startup directory in front so that 790 ;; We need to add the startup directory in front so that
787 ;; files locally redefined are properly found. We cannot 791 ;; files locally redefined are properly found. We cannot
788 ;; add ".", which varies too much depending on what the 792 ;; add ".", which varies too much depending on what the
789 ;; current buffer is. 793 ;; current buffer is.
790 (set 'project 794 (set 'project
791 (plist-put project 'src_dir 795 (plist-put project 'src_dir
792 (append 796 (append
793 (list command-line-default-directory) 797 (list command-line-default-directory)
794 (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":") 798 (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
795 (list "." default-directory)))) 799 (list "." default-directory))))
796 (set 'project 800 (set 'project
797 (plist-put project 'obj_dir 801 (plist-put project 'obj_dir
798 (append 802 (append
799 (list command-line-default-directory) 803 (list command-line-default-directory)
800 (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":") 804 (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":")
801 (list "." default-directory)))) 805 (list "." default-directory))))
802 ) 806 )
@@ -817,11 +821,11 @@ The current buffer should be the ada-file buffer."
817 ;; go to the source of the errors in a compilation buffer 821 ;; go to the source of the errors in a compilation buffer
818 (setq compilation-search-path (ada-xref-get-src-dir-field)) 822 (setq compilation-search-path (ada-xref-get-src-dir-field))
819 823
820 ;; Set the casing exceptions file list 824 ;; Set the casing exceptions file list
821 (if casing 825 (if casing
822 (progn 826 (progn
823 (setq ada-case-exception-file (reverse casing)) 827 (setq ada-case-exception-file (reverse casing))
824 (ada-case-read-exceptions))) 828 (ada-case-read-exceptions)))
825 829
826 ;; Add the directories to the search path for ff-find-other-file 830 ;; Add the directories to the search path for ff-find-other-file
827 ;; Do not add the '/' or '\' at the end 831 ;; Do not add the '/' or '\' at the end
@@ -850,21 +854,21 @@ If LOCAL-ONLY is t, only the declarations in the current file are returned."
850 (ada-require-project-file) 854 (ada-require-project-file)
851 855
852 (let* ((identlist (ada-read-identifier pos)) 856 (let* ((identlist (ada-read-identifier pos))
853 (alifile (ada-get-ali-file-name (ada-file-of identlist))) 857 (alifile (ada-get-ali-file-name (ada-file-of identlist)))
854 (process-environment (ada-set-environment))) 858 (process-environment (ada-set-environment)))
855 859
856 (set-buffer (get-file-buffer (ada-file-of identlist))) 860 (set-buffer (get-file-buffer (ada-file-of identlist)))
857 861
858 ;; if the file is more recent than the executable 862 ;; if the file is more recent than the executable
859 (if (or (buffer-modified-p (current-buffer)) 863 (if (or (buffer-modified-p (current-buffer))
860 (file-newer-than-file-p (ada-file-of identlist) alifile)) 864 (file-newer-than-file-p (ada-file-of identlist) alifile))
861 (ada-find-any-references (ada-name-of identlist) 865 (ada-find-any-references (ada-name-of identlist)
862 (ada-file-of identlist) 866 (ada-file-of identlist)
863 nil nil local-only arg) 867 nil nil local-only arg)
864 (ada-find-any-references (ada-name-of identlist) 868 (ada-find-any-references (ada-name-of identlist)
865 (ada-file-of identlist) 869 (ada-file-of identlist)
866 (ada-line-of identlist) 870 (ada-line-of identlist)
867 (ada-column-of identlist) local-only arg))) 871 (ada-column-of identlist) local-only arg)))
868 ) 872 )
869 873
870(defun ada-find-local-references (&optional pos arg) 874(defun ada-find-local-references (&optional pos arg)
@@ -897,9 +901,9 @@ buffer `*gnatfind*', if there is one."
897 (switches (ada-xref-get-project-field 'gnatfind_opt)) 901 (switches (ada-xref-get-project-field 'gnatfind_opt))
898 (command (concat "gnat find " switches " " 902 (command (concat "gnat find " switches " "
899 quote-entity 903 quote-entity
900 (if file (concat ":" (file-name-nondirectory file))) 904 (if file (concat ":" (file-name-nondirectory file)))
901 (if line (concat ":" line)) 905 (if line (concat ":" line))
902 (if column (concat ":" column)) 906 (if column (concat ":" column))
903 (if local-only (concat " " (file-name-nondirectory file))) 907 (if local-only (concat " " (file-name-nondirectory file)))
904 )) 908 ))
905 old-contents) 909 old-contents)
@@ -907,10 +911,10 @@ buffer `*gnatfind*', if there is one."
907 ;; If a project file is defined, use it 911 ;; If a project file is defined, use it
908 (if (and ada-prj-default-project-file 912 (if (and ada-prj-default-project-file
909 (not (string= ada-prj-default-project-file ""))) 913 (not (string= ada-prj-default-project-file "")))
910 (if (string-equal (file-name-extension ada-prj-default-project-file) 914 (if (string-equal (file-name-extension ada-prj-default-project-file)
911 "gpr") 915 "gpr")
912 (setq command (concat command " -P" ada-prj-default-project-file)) 916 (setq command (concat command " -P" ada-prj-default-project-file))
913 (setq command (concat command " -p" ada-prj-default-project-file)))) 917 (setq command (concat command " -p" ada-prj-default-project-file))))
914 918
915 (if (and append (get-buffer "*gnatfind*")) 919 (if (and append (get-buffer "*gnatfind*"))
916 (save-excursion 920 (save-excursion
@@ -937,21 +941,19 @@ buffer `*gnatfind*', if there is one."
937 941
938;; ----- Identifier Completion -------------------------------------------- 942;; ----- Identifier Completion --------------------------------------------
939(defun ada-complete-identifier (pos) 943(defun ada-complete-identifier (pos)
940 "Tries to complete the identifier around POS. 944 "Try to complete the identifier around POS, using compiler cross-reference information."
941The feature is only available if the files where compiled without
942the option `-gnatx'."
943 (interactive "d") 945 (interactive "d")
944 (ada-require-project-file) 946 (ada-require-project-file)
945 947
946 ;; Initialize function-local variables and jump to the .ali buffer 948 ;; Initialize function-local variables and jump to the .ali buffer
947 ;; Note that for regexp search is case insensitive too 949 ;; Note that for regexp search is case insensitive too
948 (let* ((curbuf (current-buffer)) 950 (let* ((curbuf (current-buffer))
949 (identlist (ada-read-identifier pos)) 951 (identlist (ada-read-identifier pos))
950 (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\(" 952 (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\("
951 (regexp-quote (ada-name-of identlist)) 953 (regexp-quote (ada-name-of identlist))
952 "[a-zA-Z0-9_]*\\)")) 954 "[a-zA-Z0-9_]*\\)"))
953 (completed nil) 955 (completed nil)
954 (symalist nil)) 956 (symalist nil))
955 957
956 ;; Open the .ali file 958 ;; Open the .ali file
957 (set-buffer (ada-get-ali-buffer (buffer-file-name))) 959 (set-buffer (ada-get-ali-buffer (buffer-file-name)))
@@ -990,6 +992,7 @@ the option `-gnatx'."
990 992
991(defun ada-goto-body (pos &optional other-frame) 993(defun ada-goto-body (pos &optional other-frame)
992 "Display the body of the entity around POS. 994 "Display the body of the entity around POS.
995OTHER-FRAME non-nil means display in another frame.
993If the entity doesn't have a body, display its declaration. 996If the entity doesn't have a body, display its declaration.
994As a side effect, the buffer for the declaration is also open." 997As a side effect, the buffer for the declaration is also open."
995 (interactive "d") 998 (interactive "d")
@@ -1023,7 +1026,7 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
1023 ;; entity, whose references are not given by GNAT 1026 ;; entity, whose references are not given by GNAT
1024 (if (and (file-exists-p ali-file) 1027 (if (and (file-exists-p ali-file)
1025 (file-newer-than-file-p ali-file (ada-file-of identlist))) 1028 (file-newer-than-file-p ali-file (ada-file-of identlist)))
1026 (message "No cross-reference found--may be a predefined entity.") 1029 (message "No cross-reference found -- may be a predefined entity.")
1027 1030
1028 ;; Else, look in every ALI file, except if the user doesn't want that 1031 ;; Else, look in every ALI file, except if the user doesn't want that
1029 (if ada-xref-search-with-egrep 1032 (if ada-xref-search-with-egrep
@@ -1048,8 +1051,8 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
1048 command)))) 1051 command))))
1049 1052
1050(defun ada-get-absolute-dir-list (dir-list root-dir) 1053(defun ada-get-absolute-dir-list (dir-list root-dir)
1051 "Returns the list of absolute directories found in dir-list. 1054 "Return the list of absolute directories found in DIR-LIST.
1052If a directory is a relative directory, add the value of ROOT-DIR in front." 1055If a directory is a relative directory, ROOT-DIR is prepended."
1053 (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) 1056 (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
1054 1057
1055(defun ada-set-environment () 1058(defun ada-set-environment ()
@@ -1134,12 +1137,6 @@ command, and should be either comp_cmd (default) or check_cmd."
1134 (if (or ada-xref-confirm-compile arg) 1137 (if (or ada-xref-confirm-compile arg)
1135 (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) 1138 (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1136 1139
1137 ;; Insert newlines so as to separate the name of the commands to run
1138 ;; and the output of the commands. This doesn't work with cmdproxy.exe,
1139 ;; which gets confused by newline characters.
1140 (if (not (string-match ".exe" shell-file-name))
1141 (setq cmd (concat cmd "\n\n")))
1142
1143 (compile (ada-quote-cmd cmd)))) 1140 (compile (ada-quote-cmd cmd))))
1144 1141
1145(defun ada-check-current (&optional arg) 1142(defun ada-check-current (&optional arg)
@@ -1162,7 +1159,7 @@ if ARG is not-nil, ask for user confirmation."
1162 1159
1163 ;; Guess the command if it wasn't specified 1160 ;; Guess the command if it wasn't specified
1164 (if (not command) 1161 (if (not command)
1165 (set 'command (list (file-name-sans-extension (buffer-name))))) 1162 (set 'command (list (file-name-sans-extension (buffer-name)))))
1166 1163
1167 ;; Modify the command to run remotely 1164 ;; Modify the command to run remotely
1168 (setq command (ada-remote (mapconcat 'identity command 1165 (setq command (ada-remote (mapconcat 'identity command
@@ -1197,9 +1194,9 @@ if ARG is not-nil, ask for user confirmation."
1197 1194
1198(defun ada-gdb-application (&optional arg executable-name) 1195(defun ada-gdb-application (&optional arg executable-name)
1199 "Start the debugger on the application. 1196 "Start the debugger on the application.
1197If ARG is non-nil, ask the user to confirm the command.
1200EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the 1198EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the
1201project file. 1199project file."
1202If ARG is non-nil, ask the user to confirm the command."
1203 (interactive "P") 1200 (interactive "P")
1204 (let ((buffer (current-buffer)) 1201 (let ((buffer (current-buffer))
1205 cmd pre-cmd post-cmd) 1202 cmd pre-cmd post-cmd)
@@ -1303,13 +1300,8 @@ If ARG is non-nil, ask the user to confirm the command."
1303 (switch-to-buffer buffer) 1300 (switch-to-buffer buffer)
1304 ))) 1301 )))
1305 1302
1306
1307(defun ada-reread-prj-file (&optional filename) 1303(defun ada-reread-prj-file (&optional filename)
1308 "Forces Emacs to read either FILENAME or the project file associated 1304 "Reread either the current project, or FILENAME if non-nil."
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."
1313 (interactive "P") 1305 (interactive "P")
1314 (if filename 1306 (if filename
1315 (ada-parse-prj-file filename) 1307 (ada-parse-prj-file filename)
@@ -1330,7 +1322,7 @@ the cross-reference information. Note that the ali file can then be deduced by
1330replacing the file extension with `.ali'." 1322replacing the file extension with `.ali'."
1331 ;; kill old buffer 1323 ;; kill old buffer
1332 (if (and ali-file-name 1324 (if (and ali-file-name
1333 (get-file-buffer ali-file-name)) 1325 (get-file-buffer ali-file-name))
1334 (kill-buffer (get-file-buffer ali-file-name))) 1326 (kill-buffer (get-file-buffer ali-file-name)))
1335 1327
1336 (let* ((name (ada-convert-file-name file)) 1328 (let* ((name (ada-convert-file-name file))
@@ -1375,15 +1367,15 @@ replacing the file extension with `.ali'."
1375 found)) 1367 found))
1376 1368
1377(defun ada-find-ali-file-in-dir (file) 1369(defun ada-find-ali-file-in-dir (file)
1378 "Find an .ali file in obj_dir. The current buffer must be the Ada file. 1370 "Find the ali file FILE, searching obj_dir for the current project.
1379Adds build_dir in front of the search path to conform to gnatmake's behavior, 1371Adds build_dir in front of the search path to conform to gnatmake's behavior,
1380and the standard runtime location at the end." 1372and the standard runtime location at the end."
1381 (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) 1373 (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
1382 1374
1383(defun ada-find-src-file-in-dir (file) 1375(defun ada-find-src-file-in-dir (file)
1384 "Find a source file in src_dir. The current buffer must be the Ada file. 1376 "Find the source file FILE, searching src_dir for the current project.
1385Adds src_dir in front of the search path to conform to gnatmake's behavior, 1377Adds the standard runtime location at the end of the search path to conform
1386and the standard runtime location at the end." 1378to gnatmake's behavior."
1387 (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) 1379 (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
1388 1380
1389(defun ada-get-ali-file-name (file) 1381(defun ada-get-ali-file-name (file)
@@ -1414,9 +1406,9 @@ the project file."
1414 (save-excursion 1406 (save-excursion
1415 (set-buffer (get-file-buffer file)) 1407 (set-buffer (get-file-buffer file))
1416 (let ((short-ali-file-name 1408 (let ((short-ali-file-name
1417 (concat (file-name-sans-extension (file-name-nondirectory file)) 1409 (concat (file-name-sans-extension (file-name-nondirectory file))
1418 ".ali")) 1410 ".ali"))
1419 ali-file-name 1411 ali-file-name
1420 is-spec) 1412 is-spec)
1421 1413
1422 ;; If we have a non-standard file name, and this is a spec, we first 1414 ;; If we have a non-standard file name, and this is a spec, we first
@@ -1514,15 +1506,15 @@ file for possible paths."
1514 ;; return the absolute file name 1506 ;; return the absolute file name
1515 (let ((filename (ada-find-src-file-in-dir file))) 1507 (let ((filename (ada-find-src-file-in-dir file)))
1516 (if filename 1508 (if filename
1517 (expand-file-name filename) 1509 (expand-file-name filename)
1518 (error (concat 1510 (error (concat
1519 (file-name-nondirectory file) 1511 (file-name-nondirectory file)
1520 " not found in src_dir; please check your project file"))) 1512 " not found in src_dir; please check your project file")))
1521 1513
1522 ))) 1514 )))
1523 1515
1524(defun ada-find-file-number-in-ali (file) 1516(defun ada-find-file-number-in-ali (file)
1525 "Returns the file number for FILE in the associated ali file." 1517 "Return the file number for FILE in the associated ali file."
1526 (set-buffer (ada-get-ali-buffer file)) 1518 (set-buffer (ada-get-ali-buffer file))
1527 (goto-char (point-min)) 1519 (goto-char (point-min))
1528 1520
@@ -1532,7 +1524,7 @@ file for possible paths."
1532 (count-lines begin (point)))) 1524 (count-lines begin (point))))
1533 1525
1534(defun ada-read-identifier (pos) 1526(defun ada-read-identifier (pos)
1535 "Returns the identlist around POS and switch to the .ali buffer. 1527 "Return the identlist around POS and switch to the .ali buffer.
1536The returned list represents the entity, and can be manipulated through the 1528The returned list represents the entity, and can be manipulated through the
1537macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." 1529macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
1538 1530
@@ -1553,7 +1545,7 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
1553 ;; Just in front of a string => we could have an operator declaration, 1545 ;; Just in front of a string => we could have an operator declaration,
1554 ;; as in "+", "-", .. 1546 ;; as in "+", "-", ..
1555 (if (= (char-after) ?\") 1547 (if (= (char-after) ?\")
1556 (forward-char 1)) 1548 (forward-char 1))
1557 1549
1558 ;; if looking at an operator 1550 ;; if looking at an operator
1559 ;; This is only true if: 1551 ;; This is only true if:
@@ -1563,19 +1555,19 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
1563 (or (not (= (char-syntax (char-after)) ?w)) 1555 (or (not (= (char-syntax (char-after)) ?w))
1564 (not (or (= (char-syntax (char-after (match-end 0))) ?w) 1556 (not (or (= (char-syntax (char-after (match-end 0))) ?w)
1565 (= (char-after (match-end 0)) ?_))))) 1557 (= (char-after (match-end 0)) ?_)))))
1566 (progn 1558 (progn
1567 (if (and (= (char-before) ?\") 1559 (if (and (= (char-before) ?\")
1568 (= (char-after (+ (length (match-string 0)) (point))) ?\")) 1560 (= (char-after (+ (length (match-string 0)) (point))) ?\"))
1569 (forward-char -1)) 1561 (forward-char -1))
1570 (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) 1562 (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
1571 1563
1572 (if (ada-in-string-p) 1564 (if (ada-in-string-p)
1573 (error "Inside string or character constant")) 1565 (error "Inside string or character constant"))
1574 (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) 1566 (if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
1575 (error "No cross-reference available for reserved keyword")) 1567 (error "No cross-reference available for reserved keyword"))
1576 (if (looking-at "[a-zA-Z0-9_]+") 1568 (if (looking-at "[a-zA-Z0-9_]+")
1577 (set 'identifier (match-string 0)) 1569 (set 'identifier (match-string 0))
1578 (error "No identifier around"))) 1570 (error "No identifier around")))
1579 1571
1580 ;; Build the identlist 1572 ;; Build the identlist
1581 (set 'identlist (ada-make-identlist)) 1573 (set 'identlist (ada-make-identlist))
@@ -1589,8 +1581,8 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
1589 )) 1581 ))
1590 1582
1591(defun ada-get-all-references (identlist) 1583(defun ada-get-all-references (identlist)
1592 "Completes and returns IDENTLIST with the information extracted 1584 "Complete IDENTLIST with definition file and places where it is referenced.
1593from the ali file (definition file and places where it is referenced)." 1585Information is extracted from the ali file."
1594 1586
1595 (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) 1587 (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
1596 declaration-found) 1588 declaration-found)
@@ -1605,8 +1597,8 @@ from the ali file (definition file and places where it is referenced)."
1605 (if (re-search-forward 1597 (if (re-search-forward
1606 (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) 1598 (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
1607 nil t) 1599 nil t)
1608 (let ((bound (save-excursion (re-search-forward "^X " nil t)))) 1600 (let ((bound (save-excursion (re-search-forward "^X " nil t))))
1609 (set 'declaration-found 1601 (set 'declaration-found
1610 (re-search-forward 1602 (re-search-forward
1611 (concat "^" (ada-line-of identlist) 1603 (concat "^" (ada-line-of identlist)
1612 "." (ada-column-of identlist) 1604 "." (ada-column-of identlist)
@@ -1636,10 +1628,10 @@ from the ali file (definition file and places where it is referenced)."
1636 (ada-column-of identlist) "\\>") 1628 (ada-column-of identlist) "\\>")
1637 nil t) 1629 nil t)
1638 1630
1639 ;; if we did not find it, it may be because the first reference 1631 ;; if we did not find it, it may be because the first reference
1640 ;; is not required to have a 'unit_number|' item included. 1632 ;; is not required to have a 'unit_number|' item included.
1641 ;; Or maybe we are already on the declaration... 1633 ;; Or maybe we are already on the declaration...
1642 (unless (re-search-forward 1634 (unless (re-search-forward
1643 (concat 1635 (concat
1644 "^[0-9]+.[0-9]+[ *]" 1636 "^[0-9]+.[0-9]+[ *]"
1645 (ada-name-of identlist) 1637 (ada-name-of identlist)
@@ -1653,7 +1645,7 @@ from the ali file (definition file and places where it is referenced)."
1653 ;; or the source file has been modified since the ali file was 1645 ;; or the source file has been modified since the ali file was
1654 ;; created 1646 ;; created
1655 (set 'declaration-found nil) 1647 (set 'declaration-found nil)
1656 ) 1648 )
1657 ) 1649 )
1658 1650
1659 ;; Last check to be completly sure we have found the correct line (the 1651 ;; Last check to be completly sure we have found the correct line (the
@@ -1688,15 +1680,15 @@ from the ali file (definition file and places where it is referenced)."
1688 ;; information available 1680 ;; information available
1689 (beginning-of-line) 1681 (beginning-of-line)
1690 (if declaration-found 1682 (if declaration-found
1691 (let ((current-line (buffer-substring 1683 (let ((current-line (buffer-substring
1692 (point) (save-excursion (end-of-line) (point))))) 1684 (point) (save-excursion (end-of-line) (point)))))
1693 (save-excursion 1685 (save-excursion
1694 (next-line 1) 1686 (next-line 1)
1695 (beginning-of-line) 1687 (beginning-of-line)
1696 (while (looking-at "^\\.\\(.*\\)") 1688 (while (looking-at "^\\.\\(.*\\)")
1697 (set 'current-line (concat current-line (match-string 1))) 1689 (set 'current-line (concat current-line (match-string 1)))
1698 (next-line 1)) 1690 (next-line 1))
1699 ) 1691 )
1700 1692
1701 (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) 1693 (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
1702 1694
@@ -1725,7 +1717,7 @@ This function is disabled for operators, and only works for identifiers."
1725 1717
1726 (unless (= (string-to-char (ada-name-of identlist)) ?\") 1718 (unless (= (string-to-char (ada-name-of identlist)) ?\")
1727 (progn 1719 (progn
1728 (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... )) 1720 (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
1729 (my-regexp (concat "[ *]" 1721 (my-regexp (concat "[ *]"
1730 (regexp-quote (ada-name-of identlist)) " ")) 1722 (regexp-quote (ada-name-of identlist)) " "))
1731 (line-ada "--") 1723 (line-ada "--")
@@ -1735,43 +1727,43 @@ This function is disabled for operators, and only works for identifiers."
1735 (choice 0) 1727 (choice 0)
1736 (ali-buffer (current-buffer))) 1728 (ali-buffer (current-buffer)))
1737 1729
1738 (goto-char (point-max)) 1730 (goto-char (point-max))
1739 (while (re-search-backward my-regexp nil t) 1731 (while (re-search-backward my-regexp nil t)
1740 (save-excursion 1732 (save-excursion
1741 (set 'line-ali (count-lines 1 (point))) 1733 (set 'line-ali (count-lines 1 (point)))
1742 (beginning-of-line) 1734 (beginning-of-line)
1743 ;; have a look at the line and column numbers 1735 ;; have a look at the line and column numbers
1744 (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") 1736 (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
1745 (progn 1737 (progn
1746 (setq line-ada (match-string 1)) 1738 (setq line-ada (match-string 1))
1747 (setq col-ada (match-string 2))) 1739 (setq col-ada (match-string 2)))
1748 (setq line-ada "--") 1740 (setq line-ada "--")
1749 (setq col-ada "--") 1741 (setq col-ada "--")
1750 ) 1742 )
1751 ;; construct a list with the file names and the positions within 1743 ;; 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) 1744 (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t)
1753 (add-to-list 1745 (add-to-list
1754 'declist (list line-ali (match-string 1) line-ada col-ada)) 1746 'declist (list line-ali (match-string 1) line-ada col-ada))
1755 ) 1747 )
1756 ) 1748 )
1757 ) 1749 )
1758 1750
1759 ;; how many possible declarations have we found ? 1751 ;; how many possible declarations have we found ?
1760 (setq len (length declist)) 1752 (setq len (length declist))
1761 (cond 1753 (cond
1762 ;; none => error 1754 ;; none => error
1763 ((= len 0) 1755 ((= len 0)
1764 (kill-buffer (current-buffer)) 1756 (kill-buffer (current-buffer))
1765 (error (concat "No declaration of " 1757 (error (concat "No declaration of "
1766 (ada-name-of identlist) 1758 (ada-name-of identlist)
1767 " recorded in .ali file"))) 1759 " recorded in .ali file")))
1768 1760
1769 ;; one => should be the right one 1761 ;; one => should be the right one
1770 ((= len 1) 1762 ((= len 1)
1771 (goto-line (caar declist))) 1763 (goto-line (caar declist)))
1772 1764
1773 ;; more than one => display choice list 1765 ;; more than one => display choice list
1774 (t 1766 (t
1775 (save-window-excursion 1767 (save-window-excursion
1776 (with-output-to-temp-buffer "*choice list*" 1768 (with-output-to-temp-buffer "*choice list*"
1777 1769
@@ -1782,13 +1774,13 @@ This function is disabled for operators, and only works for identifiers."
1782 (let ((counter 0)) 1774 (let ((counter 0))
1783 (while (< counter len) 1775 (while (< counter len)
1784 (princ (format " %2d) %-21s %4s %4s\n" 1776 (princ (format " %2d) %-21s %4s %4s\n"
1785 (1+ counter) 1777 (1+ counter)
1786 (ada-get-ada-file-name 1778 (ada-get-ada-file-name
1787 (nth 1 (nth counter declist)) 1779 (nth 1 (nth counter declist))
1788 (ada-file-of identlist)) 1780 (ada-file-of identlist))
1789 (nth 2 (nth counter declist)) 1781 (nth 2 (nth counter declist))
1790 (nth 3 (nth counter declist)) 1782 (nth 3 (nth counter declist))
1791 )) 1783 ))
1792 (setq counter (1+ counter)) 1784 (setq counter (1+ counter))
1793 ) ; end of while 1785 ) ; end of while
1794 ) ; end of let 1786 ) ; end of let
@@ -1804,8 +1796,8 @@ This function is disabled for operators, and only works for identifiers."
1804 (read-from-minibuffer "Enter No. of your choice: ")))) 1796 (read-from-minibuffer "Enter No. of your choice: "))))
1805 ) 1797 )
1806 (set-buffer ali-buffer) 1798 (set-buffer ali-buffer)
1807 (goto-line (car (nth (1- choice) declist))) 1799 (goto-line (car (nth (1- choice) declist)))
1808 )))))) 1800 ))))))
1809 1801
1810 1802
1811(defun ada-find-in-ali (identlist &optional other-frame) 1803(defun ada-find-in-ali (identlist &optional other-frame)
@@ -1899,7 +1891,7 @@ This command requires the external `egrep' program to be available.
1899This works well when one is using an external librarie and wants 1891This works well when one is using an external librarie and wants
1900to find the declaration and documentation of the subprograms one is 1892to find the declaration and documentation of the subprograms one is
1901is using." 1893is using."
1902 1894;; FIXME: what does this function do?
1903 (let (list 1895 (let (list
1904 (dirs (ada-xref-get-obj-dir-field)) 1896 (dirs (ada-xref-get-obj-dir-field))
1905 (regexp (concat "[ *]" (ada-name-of identlist))) 1897 (regexp (concat "[ *]" (ada-name-of identlist)))
@@ -2020,12 +2012,12 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
2020 2012
2021 ;; Select and display the destination buffer 2013 ;; Select and display the destination buffer
2022 (if ada-xref-other-buffer 2014 (if ada-xref-other-buffer
2023 (if other-frame 2015 (if other-frame
2024 (find-file-other-frame file) 2016 (find-file-other-frame file)
2025 (set 'declaration-buffer (find-file-noselect file)) 2017 (set 'declaration-buffer (find-file-noselect file))
2026 (set-buffer declaration-buffer) 2018 (set-buffer declaration-buffer)
2027 (switch-to-buffer-other-window declaration-buffer) 2019 (switch-to-buffer-other-window declaration-buffer)
2028 ) 2020 )
2029 (find-file file) 2021 (find-file file)
2030 ) 2022 )
2031 2023
@@ -2043,11 +2035,11 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
2043 2035
2044 2036
2045(defun ada-xref-search-nearest (name) 2037(defun ada-xref-search-nearest (name)
2046 "Searches for NAME nearest to the position recorded in the Xref file. 2038 "Search for NAME nearest to the position recorded in the Xref file.
2047It returns the position of the declaration in the buffer or nil if not found." 2039Return the position of the declaration in the buffer, or nil if not found."
2048 (let ((orgpos (point)) 2040 (let ((orgpos (point))
2049 (newpos nil) 2041 (newpos nil)
2050 (diff nil)) 2042 (diff nil))
2051 2043
2052 (goto-char (point-max)) 2044 (goto-char (point-max))
2053 2045
@@ -2056,33 +2048,33 @@ It returns the position of the declaration in the buffer or nil if not found."
2056 2048
2057 ;; check if it really is a complete Ada identifier 2049 ;; check if it really is a complete Ada identifier
2058 (if (and 2050 (if (and
2059 (not (save-excursion 2051 (not (save-excursion
2060 (goto-char (match-end 0)) 2052 (goto-char (match-end 0))
2061 (looking-at "_"))) 2053 (looking-at "_")))
2062 (not (ada-in-string-or-comment-p)) 2054 (not (ada-in-string-or-comment-p))
2063 (or 2055 (or
2064 ;; variable declaration ? 2056 ;; variable declaration ?
2065 (save-excursion 2057 (save-excursion
2066 (skip-chars-forward "a-zA-Z_0-9" ) 2058 (skip-chars-forward "a-zA-Z_0-9" )
2067 (ada-goto-next-non-ws) 2059 (ada-goto-next-non-ws)
2068 (looking-at ":[^=]")) 2060 (looking-at ":[^=]"))
2069 ;; procedure, function, task or package declaration ? 2061 ;; procedure, function, task or package declaration ?
2070 (save-excursion 2062 (save-excursion
2071 (ada-goto-previous-word) 2063 (ada-goto-previous-word)
2072 (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]\\>")))) 2064 (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]\\>"))))
2073 2065
2074 ;; check if it is nearer than the ones before if any 2066 ;; check if it is nearer than the ones before if any
2075 (if (or (not diff) 2067 (if (or (not diff)
2076 (< (abs (- (point) orgpos)) diff)) 2068 (< (abs (- (point) orgpos)) diff))
2077 (progn 2069 (progn
2078 (setq newpos (point) 2070 (setq newpos (point)
2079 diff (abs (- newpos orgpos)))))) 2071 diff (abs (- newpos orgpos))))))
2080 ) 2072 )
2081 2073
2082 (if newpos 2074 (if newpos
2083 (progn 2075 (progn
2084 (message "ATTENTION: this declaration is only a (good) guess ...") 2076 (message "ATTENTION: this declaration is only a (good) guess ...")
2085 (goto-char newpos)) 2077 (goto-char newpos))
2086 nil))) 2078 nil)))
2087 2079
2088 2080
@@ -2093,26 +2085,26 @@ It returns the position of the declaration in the buffer or nil if not found."
2093 (ada-require-project-file) 2085 (ada-require-project-file)
2094 2086
2095 (let ((buffer (ada-get-ali-buffer (buffer-file-name))) 2087 (let ((buffer (ada-get-ali-buffer (buffer-file-name)))
2096 (unit-name nil) 2088 (unit-name nil)
2097 (body-name nil) 2089 (body-name nil)
2098 (ali-name nil)) 2090 (ali-name nil))
2099 (save-excursion 2091 (save-excursion
2100 (set-buffer buffer) 2092 (set-buffer buffer)
2101 (goto-char (point-min)) 2093 (goto-char (point-min))
2102 (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)") 2094 (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)")
2103 (setq unit-name (match-string 1)) 2095 (setq unit-name (match-string 1))
2104 (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name)) 2096 (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name))
2105 (progn 2097 (progn
2106 (kill-buffer buffer) 2098 (kill-buffer buffer)
2107 (error "No parent unit !")) 2099 (error "No parent unit !"))
2108 (setq unit-name (match-string 1 unit-name)) 2100 (setq unit-name (match-string 1 unit-name))
2109 ) 2101 )
2110 2102
2111 ;; look for the file name for the parent unit specification 2103 ;; look for the file name for the parent unit specification
2112 (goto-char (point-min)) 2104 (goto-char (point-min))
2113 (re-search-forward (concat "^W " unit-name 2105 (re-search-forward (concat "^W " unit-name
2114 "%s[ \t]+\\([^ \t]+\\)[ \t]+" 2106 "%s[ \t]+\\([^ \t]+\\)[ \t]+"
2115 "\\([^ \t\n]+\\)")) 2107 "\\([^ \t\n]+\\)"))
2116 (setq body-name (match-string 1)) 2108 (setq body-name (match-string 1))
2117 (setq ali-name (match-string 2)) 2109 (setq ali-name (match-string 2))
2118 (kill-buffer buffer) 2110 (kill-buffer buffer)
@@ -2123,15 +2115,15 @@ It returns the position of the declaration in the buffer or nil if not found."
2123 (save-excursion 2115 (save-excursion
2124 ;; Tries to open the new ali file to find the spec file 2116 ;; Tries to open the new ali file to find the spec file
2125 (if ali-name 2117 (if ali-name
2126 (progn 2118 (progn
2127 (find-file ali-name) 2119 (find-file ali-name)
2128 (goto-char (point-min)) 2120 (goto-char (point-min))
2129 (re-search-forward (concat "^U " unit-name "%s[ \t]+" 2121 (re-search-forward (concat "^U " unit-name "%s[ \t]+"
2130 "\\([^ \t]+\\)")) 2122 "\\([^ \t]+\\)"))
2131 (setq body-name (match-string 1)) 2123 (setq body-name (match-string 1))
2132 (kill-buffer (current-buffer)) 2124 (kill-buffer (current-buffer))
2133 ) 2125 )
2134 ) 2126 )
2135 ) 2127 )
2136 2128
2137 (find-file body-name) 2129 (find-file body-name)
@@ -2146,14 +2138,14 @@ This is a GNAT specific function that uses gnatkrunch."
2146 (set-buffer krunch-buf) 2138 (set-buffer krunch-buf)
2147 ;; send adaname to external process `gnatkr'. 2139 ;; send adaname to external process `gnatkr'.
2148 (call-process "gnatkr" nil krunch-buf nil 2140 (call-process "gnatkr" nil krunch-buf nil
2149 adaname ada-krunch-args) 2141 adaname ada-krunch-args)
2150 ;; fetch output of that process 2142 ;; fetch output of that process
2151 (setq adaname (buffer-substring 2143 (setq adaname (buffer-substring
2152 (point-min) 2144 (point-min)
2153 (progn 2145 (progn
2154 (goto-char (point-min)) 2146 (goto-char (point-min))
2155 (end-of-line) 2147 (end-of-line)
2156 (point)))) 2148 (point))))
2157 (kill-buffer krunch-buf))) 2149 (kill-buffer krunch-buf)))
2158 adaname 2150 adaname
2159 ) 2151 )
@@ -2187,10 +2179,10 @@ This function typically is to be hooked into `ff-file-created-hooks'."
2187 2179
2188 ;; Call the external process gnatstub 2180 ;; Call the external process gnatstub
2189 (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts)) 2181 (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
2190 (filename (buffer-file-name (car (buffer-list)))) 2182 (filename (buffer-file-name (car (buffer-list))))
2191 (output (concat (file-name-sans-extension filename) ".adb")) 2183 (output (concat (file-name-sans-extension filename) ".adb"))
2192 (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename)) 2184 (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename))
2193 (buffer (get-buffer-create "*gnatstub*"))) 2185 (buffer (get-buffer-create "*gnatstub*")))
2194 2186
2195 (save-excursion 2187 (save-excursion
2196 (set-buffer buffer) 2188 (set-buffer buffer)
@@ -2203,25 +2195,25 @@ This function typically is to be hooked into `ff-file-created-hooks'."
2203 (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd) 2195 (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
2204 2196
2205 (if (save-excursion 2197 (if (save-excursion
2206 (set-buffer buffer) 2198 (set-buffer buffer)
2207 (goto-char (point-min)) 2199 (goto-char (point-min))
2208 (search-forward "command not found" nil t)) 2200 (search-forward "command not found" nil t))
2209 (progn 2201 (progn
2210 (message "gnatstub was not found -- using the basic algorithm") 2202 (message "gnatstub was not found -- using the basic algorithm")
2211 (sleep-for 2) 2203 (sleep-for 2)
2212 (kill-buffer buffer) 2204 (kill-buffer buffer)
2213 (ada-make-body)) 2205 (ada-make-body))
2214 2206
2215 ;; Else clean up the output 2207 ;; Else clean up the output
2216 2208
2217 (if (file-exists-p output) 2209 (if (file-exists-p output)
2218 (progn 2210 (progn
2219 (find-file output) 2211 (find-file output)
2220 (kill-buffer buffer)) 2212 (kill-buffer buffer))
2221 2213
2222 ;; display the error buffer 2214 ;; display the error buffer
2223 (display-buffer buffer) 2215 (display-buffer buffer)
2224 ) 2216 )
2225 ))) 2217 )))
2226 2218
2227(defun ada-xref-initialize () 2219(defun ada-xref-initialize ()
@@ -2237,22 +2229,9 @@ find-file...."
2237 (ada-xref-update-project-menu) 2229 (ada-xref-update-project-menu)
2238 ) 2230 )
2239 2231
2240
2241;; ----- Add to ada-mode-hook --------------------------------------------- 2232;; ----- Add to ada-mode-hook ---------------------------------------------
2242 2233
2243;; Use gvd or ddd as the default debugger if it was found
2244;; On windows, do not use the --tty switch for GVD, since this is
2245;; not supported. Actually, we do not use this on Unix either,
2246;; since otherwise there is no console window left in GVD,
2247;; and people have to use the Emacs one.
2248;; This must be done before initializing the Ada menu. 2234;; This must be done before initializing the Ada menu.
2249(if (ada-find-file-in-dir "gvd" exec-path)
2250 (set 'ada-prj-default-debugger "gvd ")
2251 (if (ada-find-file-in-dir "gvd.exe" exec-path)
2252 (set 'ada-prj-default-debugger "gvd ")
2253 (if (ada-find-file-in-dir "ddd" exec-path)
2254 (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
2255
2256(add-hook 'ada-mode-hook 'ada-xref-initialize) 2235(add-hook 'ada-mode-hook 'ada-xref-initialize)
2257 2236
2258;; Initializes the cross references to the runtime library 2237;; Initializes the cross references to the runtime library