aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2004-08-22 17:14:02 +0000
committerRichard M. Stallman2004-08-22 17:14:02 +0000
commitced16f5d0b67f5792f2f99c2b2f0593e97f955ad (patch)
tree9219cf40395aa54d1097e16c089beb5abc4dbca6
parent260763dbb07b4fff981d090f9c3d3a28758849d9 (diff)
downloademacs-ced16f5d0b67f5792f2f99c2b2f0593e97f955ad.tar.gz
emacs-ced16f5d0b67f5792f2f99c2b2f0593e97f955ad.zip
Many doc and style fixes.
(ada-find-any-references): Use compilation-start. (ada-get-ali-file-name): Improve error msg. (ada-get-ada-file-name): Likewise.
-rw-r--r--lisp/progmodes/ada-xref.el166
1 files changed, 82 insertions, 84 deletions
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index c9bfbd76c23..fc1d2d46ab3 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -33,7 +33,7 @@
33;;; for lookup and completion in Ada mode. 33;;; for lookup and completion in Ada mode.
34;;; 34;;;
35;;; If a file *.`adp' exists in the ada-file directory, then it is 35;;; If a file *.`adp' exists in the ada-file directory, then it is
36;;; read for configuration informations. It is read only the first 36;;; read for configuration informations. It is read only the first
37;;; time a cross-reference is asked for, and is not read later. 37;;; time a cross-reference is asked for, and is not read later.
38 38
39;;; You need Emacs >= 20.2 to run this package 39;;; You need Emacs >= 20.2 to run this package
@@ -55,26 +55,25 @@ Otherwise create either a new buffer or a new frame."
55 55
56(defcustom ada-xref-create-ali nil 56(defcustom ada-xref-create-ali nil
57 "*If non-nil, run gcc whenever the cross-references are not up-to-date. 57 "*If non-nil, run gcc whenever the cross-references are not up-to-date.
58If nil, the cross-reference mode will never run gcc." 58If nil, the cross-reference mode never runs gcc."
59 :type 'boolean :group 'ada) 59 :type 'boolean :group 'ada)
60 60
61(defcustom ada-xref-confirm-compile nil 61(defcustom ada-xref-confirm-compile nil
62 "*If non-nil, always ask for user confirmation before compiling or running 62 "*If non-nil, ask for confirmation before compiling or running the application."
63the application."
64 :type 'boolean :group 'ada) 63 :type 'boolean :group 'ada)
65 64
66(defcustom ada-krunch-args "0" 65(defcustom ada-krunch-args "0"
67 "*Maximum number of characters for filenames created by gnatkr. 66 "*Maximum number of characters for filenames created by `gnatkr'.
68Set to 0, if you don't use crunched filenames. This should be a string." 67Set to 0, if you don't use crunched filenames. This should be a string."
69 :type 'string :group 'ada) 68 :type 'string :group 'ada)
70 69
71(defcustom ada-gnatls-args '("-v") 70(defcustom ada-gnatls-args '("-v")
72 "*Arguments to pass to gnatfind when the location of the runtime is searched. 71 "*Arguments to pass to `gnatfind' to find location of the runtime.
73Typical use is to pass --RTS=soft-floats on some systems that support it. 72Typical use is to pass `--RTS=soft-floats' on some systems that support it.
74 73
75You can also add -I- if you do not want the current directory to be included. 74You can also add `-I-' if you do not want the current directory to be included.
76Otherwise, going from specs to bodies and back will first look for files in the 75Otherwise, going from specs to bodies and back will first look for files in the
77current directory. This only has an impact if you are not using project files, 76current directory. This only has an impact if you are not using project files,
78but only ADA_INCLUDE_PATH." 77but only ADA_INCLUDE_PATH."
79 :type '(repeat string) :group 'ada) 78 :type '(repeat string) :group 'ada)
80 79
@@ -91,14 +90,14 @@ but only ADA_INCLUDE_PATH."
91 :type 'string :group 'ada) 90 :type 'string :group 'ada)
92 91
93(defcustom ada-prj-default-gnatmake-opt "-g" 92(defcustom ada-prj-default-gnatmake-opt "-g"
94 "Default options for gnatmake." 93 "Default options for `gnatmake'."
95 :type 'string :group 'ada) 94 :type 'string :group 'ada)
96 95
97(defcustom ada-prj-gnatfind-switches "-rf" 96(defcustom ada-prj-gnatfind-switches "-rf"
98 "Default switches to use for gnatfind. 97 "Default switches to use for `gnatfind'.
99You should modify this variable, for instance to add -a, if you are working 98You should modify this variable, for instance to add `-a', if you are working
100in an environment where most ALI files are write-protected. 99in an environment where most ALI files are write-protected.
101The command gnatfind is used every time you choose the menu 100The command `gnatfind' is used every time you choose the menu
102\"Show all references\"." 101\"Show all references\"."
103 :type 'string :group 'ada) 102 :type 'string :group 'ada)
104 103
@@ -106,12 +105,12 @@ The command gnatfind is used every time you choose the menu
106 (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" 105 (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
107 " ${comp_opt}") 106 " ${comp_opt}")
108 "*Default command to be used to compile a single file. 107 "*Default command to be used to compile a single file.
109Emacs will add the filename at the end of this command. This is the same 108Emacs will add the filename at the end of this command. This is the same
110syntax as in the project file." 109syntax as in the project file."
111 :type 'string :group 'ada) 110 :type 'string :group 'ada)
112 111
113(defcustom ada-prj-default-debugger "${cross_prefix}gdb" 112(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
114 "*Default name of the debugger. We recommend either `gdb', 113 "*Default name of the debugger. We recommend either `gdb',
115`gdb --emacs_gdbtk' or `ddd --tty -fullname'." 114`gdb --emacs_gdbtk' or `ddd --tty -fullname'."
116 :type 'string :group 'ada) 115 :type 'string :group 'ada)
117 116
@@ -129,7 +128,7 @@ this string is not empty."
129 :type '(file :must-match t) :group 'ada) 128 :type '(file :must-match t) :group 'ada)
130 129
131(defcustom ada-gnatstub-opts "-q -I${src_dir}" 130(defcustom ada-gnatstub-opts "-q -I${src_dir}"
132 "*List of the options to pass to gnatsub to generate the body of a package. 131 "*List of the options to pass to `gnatsub' to generate the body of a package.
133This has the same syntax as in the project file (with variable substitution)." 132This has the same syntax as in the project file (with variable substitution)."
134 :type 'string :group 'ada) 133 :type 'string :group 'ada)
135 134
@@ -139,7 +138,7 @@ Otherwise, ask the user for the name of the project file to use."
139 :type 'boolean :group 'ada) 138 :type 'boolean :group 'ada)
140 139
141(defconst is-windows (memq system-type (quote (windows-nt))) 140(defconst is-windows (memq system-type (quote (windows-nt)))
142 "True if we are running on windows NT or windows 95.") 141 "True if we are running on Windows NT or Windows 95.")
143 142
144(defcustom ada-tight-gvd-integration nil 143(defcustom ada-tight-gvd-integration nil
145 "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging. 144 "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
@@ -149,7 +148,7 @@ If GVD is not the debugger used, nothing happens."
149(defcustom ada-xref-search-with-egrep t 148(defcustom ada-xref-search-with-egrep t
150 "*If non-nil, use egrep to find the possible declarations for an entity. 149 "*If non-nil, use egrep to find the possible declarations for an entity.
151This alternate method is used when the exact location was not found in the 150This alternate method is used when the exact location was not found in the
152information provided by GNAT. However, it might be expensive if you have a lot 151information provided by GNAT. However, it might be expensive if you have a lot
153of sources, since it will search in all the files in your project." 152of sources, since it will search in all the files in your project."
154 :type 'boolean :group 'ada) 153 :type 'boolean :group 'ada)
155 154
@@ -161,8 +160,8 @@ This hook should be used to support new formats for the project files.
161 160
162If the function can load the file with the given filename, it should create a 161If the function can load the file with the given filename, it should create a
163buffer that contains a conversion of the file to the standard format of the 162buffer that contains a conversion of the file to the standard format of the
164project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\" 163project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\"
165lines). It should return nil if it doesn't know how to convert that project 164lines.) It should return nil if it doesn't know how to convert that project
166file.") 165file.")
167 166
168 167
@@ -192,14 +191,13 @@ Used to go back to these positions.")
192 (if (string-match "cmdproxy.exe" shell-file-name) 191 (if (string-match "cmdproxy.exe" shell-file-name)
193 "cd /d" 192 "cd /d"
194 "cd") 193 "cd")
195 "Command to use to change to a specific directory. On windows systems 194 "Command to use to change to a specific directory.
196using cmdproxy.exe as the shell, we need to use /d or the drive is never 195On Windows systems using `cmdproxy.exe' as the shell,
197changed.") 196we need to use `/d' or the drive is never changed.")
198 197
199(defvar ada-command-separator (if is-windows " && " "\n") 198(defvar ada-command-separator (if is-windows " && " "\n")
200 "Separator to use when sending multiple commands to `compile' or 199 "Separator to use between multiple commands to `compile' or `start-process'.
201`start-process'. 200`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use
202cmdproxy.exe doesn't recognize multiple-line commands, so we have to use
203\"&&\" for now.") 201\"&&\" for now.")
204 202
205(defconst ada-xref-pos-ring-max 16 203(defconst ada-xref-pos-ring-max 16
@@ -247,12 +245,12 @@ As always, the values of the project file are defined through properties.")
247;; ----------------------------------------------------------------------- 245;; -----------------------------------------------------------------------
248 246
249(defun ada-quote-cmd (cmd) 247(defun ada-quote-cmd (cmd)
250 "Duplicates all \\ characters in CMD so that it can be passed to `compile'" 248 "Duplicate all \\ characters in CMD so that it can be passed to `compile'."
251 (mapconcat 'identity (split-string cmd "\\\\") "\\\\")) 249 (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
252 250
253(defun ada-initialize-runtime-library (cross-prefix) 251(defun ada-initialize-runtime-library (cross-prefix)
254 "Initializes the variables for the runtime library location. 252 "Initialize the variables for the runtime library location.
255CROSS-PREFIX is the prefix to use for the gnatls command" 253CROSS-PREFIX is the prefix to use for the gnatls command."
256 (save-excursion 254 (save-excursion
257 (setq ada-xref-runtime-library-specs-path '() 255 (setq ada-xref-runtime-library-specs-path '()
258 ada-xref-runtime-library-ali-path '()) 256 ada-xref-runtime-library-ali-path '())
@@ -591,7 +589,7 @@ This is overriden on VMS to convert from VMS filenames to Unix filenames."
591(defun ada-set-default-project-file (name &optional keep-existing) 589(defun ada-set-default-project-file (name &optional keep-existing)
592 "Set the file whose name is NAME as the default project file. 590 "Set the file whose name is NAME as the default project file.
593If KEEP-EXISTING is true and a project file has already been loaded, nothing 591If KEEP-EXISTING is true and a project file has already been loaded, nothing
594is done. This is meant to be used from ada-mode-hook, for instance to force 592is done. This is meant to be used from `ada-mode-hook', for instance, to force
595a project file unless the user has already loaded one." 593a project file unless the user has already loaded one."
596 (interactive "fProject file:") 594 (interactive "fProject file:")
597 (if (or (not keep-existing) 595 (if (or (not keep-existing)
@@ -608,7 +606,7 @@ a project file unless the user has already loaded one."
608If NO-USER-QUESTION is non-nil, use a default file if not project file was 606If NO-USER-QUESTION is non-nil, use a default file if not project file was
609found, and do not ask the user. 607found, and do not ask the user.
610If the buffer is not an Ada buffer, associate it with the default project 608If the buffer is not an Ada buffer, associate it with the default project
611file. If none is set, return nil." 609file. If none is set, return nil."
612 610
613 (let (selected) 611 (let (selected)
614 612
@@ -711,7 +709,7 @@ The current buffer should be the ada-file buffer."
711 (ada-xref-set-default-prj-values 'project (current-buffer)) 709 (ada-xref-set-default-prj-values 'project (current-buffer))
712 710
713 ;; Do not use find-file below, since we don't want to show this 711 ;; Do not use find-file below, since we don't want to show this
714 ;; buffer. If the file is open through speedbar, we can't use 712 ;; buffer. If the file is open through speedbar, we can't use
715 ;; find-file anyway, since the speedbar frame is special and does not 713 ;; find-file anyway, since the speedbar frame is special and does not
716 ;; allow the selection of a file in it. 714 ;; allow the selection of a file in it.
717 715
@@ -786,7 +784,7 @@ The current buffer should be the ada-file buffer."
786 ;; Else the file wasn't readable (probably the default project). 784 ;; Else the file wasn't readable (probably the default project).
787 ;; We initialize it with the current environment variables. 785 ;; We initialize it with the current environment variables.
788 ;; We need to add the startup directory in front so that 786 ;; We need to add the startup directory in front so that
789 ;; files locally redefined are properly found. We cannot 787 ;; files locally redefined are properly found. We cannot
790 ;; add ".", which varies too much depending on what the 788 ;; add ".", which varies too much depending on what the
791 ;; current buffer is. 789 ;; current buffer is.
792 (set 'project 790 (set 'project
@@ -836,7 +834,7 @@ The current buffer should be the ada-file buffer."
836 834
837 ;; No prj file ? => Setup default values 835 ;; No prj file ? => Setup default values
838 ;; Note that nil means that all compilation modes will first look in the 836 ;; Note that nil means that all compilation modes will first look in the
839 ;; current directory, and only then in the current file's directory. This 837 ;; current directory, and only then in the current file's directory. This
840 ;; current file is assumed at this point to be in the common source 838 ;; current file is assumed at this point to be in the common source
841 ;; directory. 839 ;; directory.
842 (setq compilation-search-path (list nil default-directory)) 840 (setq compilation-search-path (list nil default-directory))
@@ -846,10 +844,9 @@ The current buffer should be the ada-file buffer."
846(defun ada-find-references (&optional pos arg local-only) 844(defun ada-find-references (&optional pos arg local-only)
847 "Find all references to the entity under POS. 845 "Find all references to the entity under POS.
848Calls gnatfind to find the references. 846Calls gnatfind to find the references.
849if ARG is t, the contents of the old *gnatfind* buffer is preserved. 847If ARG is t, the contents of the old *gnatfind* buffer is preserved.
850if LOCAL-ONLY is t, only the declarations in the current file are returned." 848If LOCAL-ONLY is t, only the declarations in the current file are returned."
851 (interactive "d 849 (interactive "d\nP")
852P")
853 (ada-require-project-file) 850 (ada-require-project-file)
854 851
855 (let* ((identlist (ada-read-identifier pos)) 852 (let* ((identlist (ada-read-identifier pos))
@@ -872,24 +869,23 @@ P")
872 869
873(defun ada-find-local-references (&optional pos arg) 870(defun ada-find-local-references (&optional pos arg)
874 "Find all references to the entity under POS. 871 "Find all references to the entity under POS.
875Calls gnatfind to find the references. 872Calls `gnatfind' to find the references.
876if ARG is t, the contents of the old *gnatfind* buffer is preserved." 873If ARG is t, the contents of the old *gnatfind* buffer is preserved."
877 (interactive "d 874 (interactive "d\nP")
878P")
879 (ada-find-references pos arg t)) 875 (ada-find-references pos arg t))
880 876
881(defun ada-find-any-references 877(defun ada-find-any-references
882 (entity &optional file line column local-only append) 878 (entity &optional file line column local-only append)
883 "Search for references to any entity whose name is ENTITY. 879 "Search for references to any entity whose name is ENTITY.
884ENTITY was first found the location given by FILE, LINE and COLUMN. 880ENTITY was first found the location given by FILE, LINE and COLUMN.
885If LOCAL-ONLY is t, then only the references in file will be listed, which 881If LOCAL-ONLY is t, then list only the references in FILE, which
886is much faster. 882is much faster.
887If APPEND is t, then the output of the command will be append to the existing 883If APPEND is t, then append the output of the command to the existing
888buffer *gnatfind* if it exists." 884buffer `*gnatfind*', if there is one."
889 (interactive "sEntity name: ") 885 (interactive "sEntity name: ")
890 (ada-require-project-file) 886 (ada-require-project-file)
891 887
892 ;; Prepare the gnatfind command. Note that we must protect the quotes 888 ;; Prepare the gnatfind command. Note that we must protect the quotes
893 ;; around operators, so that they are correctly handled and can be 889 ;; around operators, so that they are correctly handled and can be
894 ;; processed (gnatfind \"+\":...). 890 ;; processed (gnatfind \"+\":...).
895 (let* ((quote-entity 891 (let* ((quote-entity
@@ -921,7 +917,8 @@ buffer *gnatfind* if it exists."
921 (set-buffer "*gnatfind*") 917 (set-buffer "*gnatfind*")
922 (setq old-contents (buffer-string)))) 918 (setq old-contents (buffer-string))))
923 919
924 (compile-internal command "No more references" "gnatfind") 920 (let ((compilation-error "reference"))
921 (compilation-start command))
925 922
926 ;; Hide the "Compilation" menu 923 ;; Hide the "Compilation" menu
927 (save-excursion 924 (save-excursion
@@ -941,8 +938,8 @@ buffer *gnatfind* if it exists."
941;; ----- Identifier Completion -------------------------------------------- 938;; ----- Identifier Completion --------------------------------------------
942(defun ada-complete-identifier (pos) 939(defun ada-complete-identifier (pos)
943 "Tries to complete the identifier around POS. 940 "Tries to complete the identifier around POS.
944The feature is only available if the files where compiled not using the -gnatx 941The feature is only available if the files where compiled without
945option." 942the option `-gnatx'."
946 (interactive "d") 943 (interactive "d")
947 (ada-require-project-file) 944 (ada-require-project-file)
948 945
@@ -1026,12 +1023,12 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
1026 ;; entity, whose references are not given by GNAT 1023 ;; entity, whose references are not given by GNAT
1027 (if (and (file-exists-p ali-file) 1024 (if (and (file-exists-p ali-file)
1028 (file-newer-than-file-p ali-file (ada-file-of identlist))) 1025 (file-newer-than-file-p ali-file (ada-file-of identlist)))
1029 (message "No cross-reference found. It might be a predefined entity.") 1026 (message "No cross-reference found--may be a predefined entity.")
1030 1027
1031 ;; Else, look in every ALI file, except if the user doesn't want that 1028 ;; Else, look in every ALI file, except if the user doesn't want that
1032 (if ada-xref-search-with-egrep 1029 (if ada-xref-search-with-egrep
1033 (ada-find-in-src-path identlist other-frame) 1030 (ada-find-in-src-path identlist other-frame)
1034 (message "Cross-referencing information is not up-to-date. Please recompile.") 1031 (message "Cross-referencing information is not up-to-date; please recompile.")
1035 ))))))) 1032 )))))))
1036 1033
1037(defun ada-goto-declaration-other-frame (pos) 1034(defun ada-goto-declaration-other-frame (pos)
@@ -1052,12 +1049,13 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
1052 1049
1053(defun ada-get-absolute-dir-list (dir-list root-dir) 1050(defun ada-get-absolute-dir-list (dir-list root-dir)
1054 "Returns the list of absolute directories found in dir-list. 1051 "Returns the list of absolute directories found in dir-list.
1055If a directory is a relative directory, the value of ROOT-DIR is added in 1052If a directory is a relative directory, add the value of ROOT-DIR in front."
1056front."
1057 (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) 1053 (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
1058 1054
1059(defun ada-set-environment () 1055(defun ada-set-environment ()
1060 "Return the new value for process-environment. 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.
1061It modifies the source path and object path with the values found in the 1059It modifies the source path and object path with the values found in the
1062project file." 1060project file."
1063 (let ((include (getenv "ADA_INCLUDE_PATH")) 1061 (let ((include (getenv "ADA_INCLUDE_PATH"))
@@ -1082,7 +1080,7 @@ project file."
1082 process-environment)))) 1080 process-environment))))
1083 1081
1084(defun ada-compile-application (&optional arg) 1082(defun ada-compile-application (&optional arg)
1085 "Compiles the application, using the command found in the project file. 1083 "Compile the application, using the command found in the project file.
1086If ARG is not nil, ask for user confirmation." 1084If ARG is not nil, ask for user confirmation."
1087 (interactive "P") 1085 (interactive "P")
1088 (ada-require-project-file) 1086 (ada-require-project-file)
@@ -1104,7 +1102,7 @@ If ARG is not nil, ask for user confirmation."
1104 (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) 1102 (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1105 1103
1106 ;; Insert newlines so as to separate the name of the commands to run 1104 ;; Insert newlines so as to separate the name of the commands to run
1107 ;; and the output of the commands. this doesn't work with cmdproxy.exe, 1105 ;; and the output of the commands. This doesn't work with cmdproxy.exe,
1108 ;; which gets confused by newline characters. 1106 ;; which gets confused by newline characters.
1109 (if (not (string-match ".exe" shell-file-name)) 1107 (if (not (string-match ".exe" shell-file-name))
1110 (setq cmd (concat cmd "\n\n"))) 1108 (setq cmd (concat cmd "\n\n")))
@@ -1137,7 +1135,7 @@ command, and should be either comp_cmd (default) or check_cmd."
1137 (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) 1135 (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1138 1136
1139 ;; Insert newlines so as to separate the name of the commands to run 1137 ;; Insert newlines so as to separate the name of the commands to run
1140 ;; and the output of the commands. this doesn't work with cmdproxy.exe, 1138 ;; and the output of the commands. This doesn't work with cmdproxy.exe,
1141 ;; which gets confused by newline characters. 1139 ;; which gets confused by newline characters.
1142 (if (not (string-match ".exe" shell-file-name)) 1140 (if (not (string-match ".exe" shell-file-name))
1143 (setq cmd (concat cmd "\n\n"))) 1141 (setq cmd (concat cmd "\n\n")))
@@ -1152,7 +1150,7 @@ If ARG is not nil, ask for user confirmation of the command."
1152 1150
1153(defun ada-run-application (&optional arg) 1151(defun ada-run-application (&optional arg)
1154 "Run the application. 1152 "Run the application.
1155if ARG is not-nil, asks for user confirmation." 1153if ARG is not-nil, ask for user confirmation."
1156 (interactive) 1154 (interactive)
1157 (ada-require-project-file) 1155 (ada-require-project-file)
1158 1156
@@ -1227,7 +1225,7 @@ If ARG is non-nil, ask the user to confirm the command."
1227 ;; We make sure that gvd swallows the new frame, not the one the 1225 ;; We make sure that gvd swallows the new frame, not the one the
1228 ;; user has been using until now 1226 ;; user has been using until now
1229 ;; The frame is made invisible initially, so that GtkPlug gets a 1227 ;; The frame is made invisible initially, so that GtkPlug gets a
1230 ;; chance to fully manage it. Then it works fine with Enlightenment 1228 ;; chance to fully manage it. Then it works fine with Enlightenment
1231 ;; as well 1229 ;; as well
1232 (let ((frame (make-frame '((visibility . nil))))) 1230 (let ((frame (make-frame '((visibility . nil)))))
1233 (set 'cmd (concat 1231 (set 'cmd (concat
@@ -1297,7 +1295,7 @@ If ARG is non-nil, ask the user to confirm the command."
1297 (end-of-buffer) 1295 (end-of-buffer)
1298 1296
1299 ;; Display both the source window and the debugger window (the former 1297 ;; Display both the source window and the debugger window (the former
1300 ;; above the latter). No need to show the debugger window unless it 1298 ;; above the latter). No need to show the debugger window unless it
1301 ;; is going to have some relevant information. 1299 ;; is going to have some relevant information.
1302 (if (or (not (string-match "gvd" (comint-arguments cmd 0 0))) 1300 (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
1303 (string-match "--tty" cmd)) 1301 (string-match "--tty" cmd))
@@ -1328,8 +1326,8 @@ automatically modifies the setup for all the Ada buffer that use this file."
1328 "Update the cross-references for FILE. 1326 "Update the cross-references for FILE.
1329This in fact recompiles FILE to create ALI-FILE-NAME. 1327This in fact recompiles FILE to create ALI-FILE-NAME.
1330This function returns the name of the file that was recompiled to generate 1328This function returns the name of the file that was recompiled to generate
1331the cross-reference information. Note that the ali file can then be deduced by 1329the cross-reference information. Note that the ali file can then be deduced by
1332replacing the file extension with .ali" 1330replacing the file extension with `.ali'."
1333 ;; kill old buffer 1331 ;; kill old buffer
1334 (if (and ali-file-name 1332 (if (and ali-file-name
1335 (get-file-buffer ali-file-name)) 1333 (get-file-buffer ali-file-name))
@@ -1338,7 +1336,7 @@ replacing the file extension with .ali"
1338 (let* ((name (ada-convert-file-name file)) 1336 (let* ((name (ada-convert-file-name file))
1339 (body-name (or (ada-get-body-name name) name))) 1337 (body-name (or (ada-get-body-name name) name)))
1340 1338
1341 ;; Always recompile the body when we can. We thus temporarily switch to a 1339 ;; Always recompile the body when we can. We thus temporarily switch to a
1342 ;; buffer than contains the body of the unit 1340 ;; buffer than contains the body of the unit
1343 (save-excursion 1341 (save-excursion
1344 (let ((body-visible (find-buffer-visiting body-name)) 1342 (let ((body-visible (find-buffer-visiting body-name))
@@ -1347,7 +1345,7 @@ replacing the file extension with .ali"
1347 (set-buffer body-visible) 1345 (set-buffer body-visible)
1348 (find-file body-name)) 1346 (find-file body-name))
1349 1347
1350 ;; Execute the compilation. Note that we must wait for the end of the 1348 ;; Execute the compilation. Note that we must wait for the end of the
1351 ;; process, or the ALI file would still not be available. 1349 ;; process, or the ALI file would still not be available.
1352 ;; Unfortunately, the underlying `compile' command that we use is 1350 ;; Unfortunately, the underlying `compile' command that we use is
1353 ;; asynchronous. 1351 ;; asynchronous.
@@ -1377,13 +1375,13 @@ replacing the file extension with .ali"
1377 found)) 1375 found))
1378 1376
1379(defun ada-find-ali-file-in-dir (file) 1377(defun ada-find-ali-file-in-dir (file)
1380 "Find an .ali file in obj_dir. The current buffer must be the Ada file. 1378 "Find an .ali file in obj_dir. The current buffer must be the Ada file.
1381Adds build_dir in front of the search path to conform to gnatmake's behavior, 1379Adds build_dir in front of the search path to conform to gnatmake's behavior,
1382and the standard runtime location at the end." 1380and the standard runtime location at the end."
1383 (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) 1381 (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
1384 1382
1385(defun ada-find-src-file-in-dir (file) 1383(defun ada-find-src-file-in-dir (file)
1386 "Find a source file in src_dir. The current buffer must be the Ada file. 1384 "Find a source file in src_dir. The current buffer must be the Ada file.
1387Adds src_dir in front of the search path to conform to gnatmake's behavior, 1385Adds src_dir in front of the search path to conform to gnatmake's behavior,
1388and the standard runtime location at the end." 1386and the standard runtime location at the end."
1389 (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) 1387 (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
@@ -1400,7 +1398,7 @@ the project file."
1400 ;; and look for this file 1398 ;; and look for this file
1401 ;; 2- If this file is found: 1399 ;; 2- If this file is found:
1402 ;; grep the "^U" lines, and make sure we are not reading the 1400 ;; grep the "^U" lines, and make sure we are not reading the
1403 ;; .ali file for a spec file. If we are, go to step 3. 1401 ;; .ali file for a spec file. If we are, go to step 3.
1404 ;; 3- If the file is not found or step 2 failed: 1402 ;; 3- If the file is not found or step 2 failed:
1405 ;; find the name of the "other file", ie the body, and look 1403 ;; find the name of the "other file", ie the body, and look
1406 ;; for its associated .ali file by subtituing the extension 1404 ;; for its associated .ali file by subtituing the extension
@@ -1408,9 +1406,9 @@ the project file."
1408 ;; We must also handle the case of separate packages and subprograms: 1406 ;; We must also handle the case of separate packages and subprograms:
1409 ;; 4- If no ali file was found, we try to modify the file name by removing 1407 ;; 4- If no ali file was found, we try to modify the file name by removing
1410 ;; everything after the last '-' or '.' character, so as to get the 1408 ;; everything after the last '-' or '.' character, so as to get the
1411 ;; ali file for the parent unit. If we found an ali file, we check that 1409 ;; ali file for the parent unit. If we found an ali file, we check that
1412 ;; it indeed contains the definition for the separate entity by checking 1410 ;; it indeed contains the definition for the separate entity by checking
1413 ;; the 'D' lines. This is done repeatedly, in case the direct parent is 1411 ;; the 'D' lines. This is done repeatedly, in case the direct parent is
1414 ;; also a separate. 1412 ;; also a separate.
1415 1413
1416 (save-excursion 1414 (save-excursion
@@ -1423,7 +1421,7 @@ the project file."
1423 1421
1424 ;; If we have a non-standard file name, and this is a spec, we first 1422 ;; If we have a non-standard file name, and this is a spec, we first
1425 ;; look for the .ali file of the body, since this is the one that 1423 ;; look for the .ali file of the body, since this is the one that
1426 ;; contains the most complete information. If not found, we will do what 1424 ;; contains the most complete information. If not found, we will do what
1427 ;; we can with the .ali file for the spec... 1425 ;; we can with the .ali file for the spec...
1428 1426
1429 (if (not (string= (file-name-extension file) "ads")) 1427 (if (not (string= (file-name-extension file) "ads"))
@@ -1476,8 +1474,8 @@ the project file."
1476 1474
1477 ;; If still not found, try to recompile the file 1475 ;; If still not found, try to recompile the file
1478 (if (not ali-file-name) 1476 (if (not ali-file-name)
1479 ;; recompile only if the user asked for this. and search the ali 1477 ;; Recompile only if the user asked for this, and search the ali
1480 ;; filename again. We avoid a possible infinite recursion by 1478 ;; filename again. We avoid a possible infinite recursion by
1481 ;; temporarily disabling the automatic compilation. 1479 ;; temporarily disabling the automatic compilation.
1482 1480
1483 (if ada-xref-create-ali 1481 (if ada-xref-create-ali
@@ -1485,7 +1483,7 @@ the project file."
1485 (concat (file-name-sans-extension (ada-xref-current file)) 1483 (concat (file-name-sans-extension (ada-xref-current file))
1486 ".ali")) 1484 ".ali"))
1487 1485
1488 (error "Ali file not found. Recompile your file")) 1486 (error "`.ali' file not found; recompile your source file"))
1489 1487
1490 1488
1491 ;; same if the .ali file is too old and we must recompile it 1489 ;; same if the .ali file is too old and we must recompile it
@@ -1499,7 +1497,7 @@ the project file."
1499 1497
1500(defun ada-get-ada-file-name (file original-file) 1498(defun ada-get-ada-file-name (file original-file)
1501 "Create the complete file name (+directory) for FILE. 1499 "Create the complete file name (+directory) for FILE.
1502The original file (where the user was) is ORIGINAL-FILE. Search in project 1500The original file (where the user was) is ORIGINAL-FILE. Search in project
1503file for possible paths." 1501file for possible paths."
1504 1502
1505 (save-excursion 1503 (save-excursion
@@ -1519,7 +1517,7 @@ file for possible paths."
1519 (expand-file-name filename) 1517 (expand-file-name filename)
1520 (error (concat 1518 (error (concat
1521 (file-name-nondirectory file) 1519 (file-name-nondirectory file)
1522 " not found in src_dir. Please check your project file"))) 1520 " not found in src_dir; please check your project file")))
1523 1521
1524 ))) 1522 )))
1525 1523
@@ -1671,13 +1669,13 @@ from the ali file (definition file and places where it is referenced)."
1671 (set 'declaration-found nil)))) 1669 (set 'declaration-found nil))))
1672 1670
1673 ;; Still no success ! The ali file must be too old, and we need to 1671 ;; Still no success ! The ali file must be too old, and we need to
1674 ;; use a basic algorithm based on guesses. Note that this only happens 1672 ;; use a basic algorithm based on guesses. Note that this only happens
1675 ;; if the user does not want us to automatically recompile files 1673 ;; if the user does not want us to automatically recompile files
1676 ;; automatically 1674 ;; automatically
1677 (unless declaration-found 1675 (unless declaration-found
1678 (if (ada-xref-find-in-modified-ali identlist) 1676 (if (ada-xref-find-in-modified-ali identlist)
1679 (set 'declaration-found t) 1677 (set 'declaration-found t)
1680 ;; no more idea to find the declaration. Give up 1678 ;; No more idea to find the declaration. Give up
1681 (progn 1679 (progn
1682 (kill-buffer ali-buffer) 1680 (kill-buffer ali-buffer)
1683 (error (concat "No declaration of " (ada-name-of identlist) 1681 (error (concat "No declaration of " (ada-name-of identlist)
@@ -1911,7 +1909,7 @@ is using."
1911 1909
1912 (save-excursion 1910 (save-excursion
1913 1911
1914 ;; Do the grep in all the directories. We do multiple shell 1912 ;; Do the grep in all the directories. We do multiple shell
1915 ;; commands instead of one in case there is no .ali file in one 1913 ;; commands instead of one in case there is no .ali file in one
1916 ;; of the directory and the shell stops because of that. 1914 ;; of the directory and the shell stops because of that.
1917 1915
@@ -2011,7 +2009,7 @@ is using."
2011 (file line column identlist &optional other-frame) 2009 (file line column identlist &optional other-frame)
2012 "Select and display FILE, at LINE and COLUMN. 2010 "Select and display FILE, at LINE and COLUMN.
2013If we do not end on the same identifier as IDENTLIST, find the closest 2011If we do not end on the same identifier as IDENTLIST, find the closest
2014match. Kills the .ali buffer at the end. 2012match. Kills the .ali buffer at the end.
2015If OTHER-FRAME is non-nil, creates a new frame to show the file." 2013If OTHER-FRAME is non-nil, creates a new frame to show the file."
2016 2014
2017 (let (declaration-buffer) 2015 (let (declaration-buffer)
@@ -2178,7 +2176,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
2178 (unless (buffer-file-name (car (buffer-list))) 2176 (unless (buffer-file-name (car (buffer-list)))
2179 (set-buffer (cadr (buffer-list)))) 2177 (set-buffer (cadr (buffer-list))))
2180 2178
2181 ;; Make sure we have a project file (for parameters to gnatstub). Note that 2179 ;; Make sure we have a project file (for parameters to gnatstub). Note that
2182 ;; this might have already been done if we have been called from the hook, 2180 ;; this might have already been done if we have been called from the hook,
2183 ;; but this is not an expensive call) 2181 ;; but this is not an expensive call)
2184 (ada-require-project-file) 2182 (ada-require-project-file)
@@ -2240,9 +2238,9 @@ find-file...."
2240 2238
2241;; Use gvd or ddd as the default debugger if it was found 2239;; Use gvd or ddd as the default debugger if it was found
2242;; On windows, do not use the --tty switch for GVD, since this is 2240;; On windows, do not use the --tty switch for GVD, since this is
2243;; not supported. Actually, we do not use this on Unix either, since otherwise 2241;; not supported. Actually, we do not use this on Unix either,
2244;; there is no console window left in GVD, and people have to use the 2242;; since otherwise there is no console window left in GVD,
2245;; Emacs one. 2243;; and people have to use the Emacs one.
2246;; This must be done before initializing the Ada menu. 2244;; This must be done before initializing the Ada menu.
2247(if (ada-find-file-in-dir "gvd" exec-path) 2245(if (ada-find-file-in-dir "gvd" exec-path)
2248 (set 'ada-prj-default-debugger "gvd ") 2246 (set 'ada-prj-default-debugger "gvd ")