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