diff options
| -rw-r--r-- | lisp/progmodes/ada-xref.el | 1550 |
1 files changed, 958 insertions, 592 deletions
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 6c3807a9886..5cf2c2e75b9 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el | |||
| @@ -1,12 +1,13 @@ | |||
| 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, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001 |
| 4 | ;; Free Software Foundation, Inc. | ||
| 4 | 5 | ||
| 5 | ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> | 6 | ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> |
| 6 | ;; Rolf Ebert <ebert@inf.enst.fr> | 7 | ;; Rolf Ebert <ebert@inf.enst.fr> |
| 7 | ;; Emmanuel Briot <briot@gnat.com> | 8 | ;; Emmanuel Briot <briot@gnat.com> |
| 8 | ;; Maintainer: Emmanuel Briot <briot@gnat.com> | 9 | ;; Maintainer: Emmanuel Briot <briot@gnat.com> |
| 9 | ;; Ada Core Technologies's version: $Revision: 1.7 $ | 10 | ;; Ada Core Technologies's version: $Revision: 1.150 $ |
| 10 | ;; Keywords: languages ada xref | 11 | ;; Keywords: languages ada xref |
| 11 | 12 | ||
| 12 | ;; This file is part of GNU Emacs. | 13 | ;; This file is part of GNU Emacs. |
| @@ -31,27 +32,6 @@ | |||
| 31 | ;;; cross reference capabilities of the GNAT Ada compiler | 32 | ;;; cross reference capabilities of the GNAT Ada compiler |
| 32 | ;;; for lookup and completion in Ada mode. | 33 | ;;; for lookup and completion in Ada mode. |
| 33 | ;;; | 34 | ;;; |
| 34 | ;;; The functions provided are the following ones : | ||
| 35 | ;;; - `ada-complete-identifier': completes the current identifier as much as | ||
| 36 | ;;; possible, depending of the known identifier in the unit | ||
| 37 | ;;; - `ada-point-and-xref': moves the mouse pointer and shows the declaration | ||
| 38 | ;;; of the selected identifier (either in the same buffer or in another | ||
| 39 | ;;; buffer | ||
| 40 | ;;; - `ada-goto-declaration': shows the declaration of the selected | ||
| 41 | ;;; identifier (the one under the cursor), either in the same buffer or in | ||
| 42 | ;;; another buffer | ||
| 43 | ;;; - `ada-goto-declaration-other-frame': same as previous, but opens a new | ||
| 44 | ;; frame to show the declaration | ||
| 45 | ;;; - `ada-compile-application': recompile your whole application, provided | ||
| 46 | ;;; that a project file exists in your directory | ||
| 47 | ;;; - `ada-run-application': run your application directly from Emacs | ||
| 48 | ;;; - `ada-reread-prj-file': force Emacs to read your project file again. | ||
| 49 | ;;; Otherwise, this file is only read the first time Emacs needs some | ||
| 50 | ;;; informations, which are then kept in memory | ||
| 51 | ;;; - `ada-change-prj': change the prj file associated with a buffer | ||
| 52 | ;;; - `ada-change-default-prj': change the default project file used for | ||
| 53 | ;;; every new buffer | ||
| 54 | ;;; | ||
| 55 | ;;; 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 |
| 56 | ;;; read for configuration informations. It is read only the first | 36 | ;;; read for configuration informations. It is read only the first |
| 57 | ;;; 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. |
| @@ -86,7 +66,7 @@ the application." | |||
| 86 | Set to 0, if you don't use crunched filenames. This should be a string." | 66 | Set to 0, if you don't use crunched filenames. This should be a string." |
| 87 | :type 'string :group 'ada) | 67 | :type 'string :group 'ada) |
| 88 | 68 | ||
| 89 | (defcustom ada-prj-default-comp-opt "-gnatq" | 69 | (defcustom ada-prj-default-comp-opt "-gnatq -gnatQ" |
| 90 | "Default compilation options." | 70 | "Default compilation options." |
| 91 | :type 'string :group 'ada) | 71 | :type 'string :group 'ada) |
| 92 | 72 | ||
| @@ -102,8 +82,16 @@ Set to 0, if you don't use crunched filenames. This should be a string." | |||
| 102 | "Default options for gnatmake." | 82 | "Default options for gnatmake." |
| 103 | :type 'string :group 'ada) | 83 | :type 'string :group 'ada) |
| 104 | 84 | ||
| 85 | (defcustom ada-prj-gnatfind-switches "-rf" | ||
| 86 | "Default switches to use for gnatfind. | ||
| 87 | You should modify this variable, for instance to add -a, if you are working | ||
| 88 | in an environment where most ALI files are write-protected. | ||
| 89 | The command gnatfind is used every time you choose the menu | ||
| 90 | \"Show all references\"." | ||
| 91 | :type 'string :group 'ada) | ||
| 92 | |||
| 105 | (defcustom ada-prj-default-comp-cmd | 93 | (defcustom ada-prj-default-comp-cmd |
| 106 | "${cross_prefix}gcc -c ${comp_opt}" | 94 | "${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current}" |
| 107 | "*Default command to be used to compile a single file. | 95 | "*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 | 96 | Emacs will add the filename at the end of this command. This is the same |
| 109 | syntax as in the project file." | 97 | syntax as in the project file." |
| @@ -137,6 +125,13 @@ This has the same syntax as in the project file (with variable substitution)." | |||
| 137 | Otherwise, ask the user for the name of the project file to use." | 125 | Otherwise, ask the user for the name of the project file to use." |
| 138 | :type 'boolean :group 'ada) | 126 | :type 'boolean :group 'ada) |
| 139 | 127 | ||
| 128 | (defconst is-windows (memq system-type (quote (windows-nt))) | ||
| 129 | "True if we are running on windows NT or windows 95.") | ||
| 130 | |||
| 131 | (defcustom ada-tight-gvd-integration nil | ||
| 132 | "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging. | ||
| 133 | If GVD is not the debugger used, nothing happens.") | ||
| 134 | |||
| 140 | ;; ------- Nothing to be modified by the user below this | 135 | ;; ------- Nothing to be modified by the user below this |
| 141 | (defvar ada-last-prj-file "" | 136 | (defvar ada-last-prj-file "" |
| 142 | "Name of the last project file entered by the user.") | 137 | "Name of the last project file entered by the user.") |
| @@ -144,12 +139,9 @@ Otherwise, ask the user for the name of the project file to use." | |||
| 144 | (defvar ada-check-switch "-gnats" | 139 | (defvar ada-check-switch "-gnats" |
| 145 | "Switch added to the command line to check the current file.") | 140 | "Switch added to the command line to check the current file.") |
| 146 | 141 | ||
| 147 | (defvar ada-project-file-extension ".adp" | 142 | (defconst ada-project-file-extension ".adp" |
| 148 | "The extension used for project files.") | 143 | "The extension used for project files.") |
| 149 | 144 | ||
| 150 | (defconst is-windows (memq system-type (quote (windows-nt))) | ||
| 151 | "True if we are running on windows NT or windows 95.") | ||
| 152 | |||
| 153 | (defvar ada-xref-runtime-library-specs-path '() | 145 | (defvar ada-xref-runtime-library-specs-path '() |
| 154 | "Directories where the specs for the standard library is found. | 146 | "Directories where the specs for the standard library is found. |
| 155 | This is used for cross-references.") | 147 | This is used for cross-references.") |
| @@ -162,6 +154,20 @@ This is used for cross-references.") | |||
| 162 | "List of positions selected by the cross-references functions. | 154 | "List of positions selected by the cross-references functions. |
| 163 | Used to go back to these positions.") | 155 | Used to go back to these positions.") |
| 164 | 156 | ||
| 157 | (defvar ada-cd-command | ||
| 158 | (if (string-match "cmdproxy.exe" shell-file-name) | ||
| 159 | "cd /d" | ||
| 160 | "cd") | ||
| 161 | "Command to use to change to a specific directory. On windows systems | ||
| 162 | using cmdproxy.exe as the shell, we need to use /d or the drive is never | ||
| 163 | changed.") | ||
| 164 | |||
| 165 | (defvar ada-command-separator (if is-windows " && " "\n") | ||
| 166 | "Separator to use when sending multiple commands to `compile' or | ||
| 167 | `start-process'. | ||
| 168 | cmdproxy.exe doesn't recognize multiple-line commands, so we have to use | ||
| 169 | \"&&\" for now.") | ||
| 170 | |||
| 165 | (defconst ada-xref-pos-ring-max 16 | 171 | (defconst ada-xref-pos-ring-max 16 |
| 166 | "Number of positions kept in the list ada-xref-pos-ring.") | 172 | "Number of positions kept in the list ada-xref-pos-ring.") |
| 167 | 173 | ||
| @@ -169,35 +175,22 @@ Used to go back to these positions.") | |||
| 169 | "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>" | 175 | "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>" |
| 170 | "Regexp to match for operators.") | 176 | "Regexp to match for operators.") |
| 171 | 177 | ||
| 172 | (defvar ada-xref-default-prj-file nil | ||
| 173 | "Name of the default prj file, per directory. | ||
| 174 | Every directory is potentially associated with a default project file. | ||
| 175 | If it is nil, then the first prj file loaded will be the default for this | ||
| 176 | Emacs session.") | ||
| 177 | |||
| 178 | |||
| 179 | (defvar ada-xref-project-files '() | 178 | (defvar ada-xref-project-files '() |
| 180 | "Associative list of project files. | 179 | "Associative list of project files. |
| 181 | It has the following format: | 180 | It has the following format: |
| 182 | \((project_name . value) (project_name . value) ...) | 181 | \((project_name . value) (project_name . value) ...) |
| 183 | As always, the values of the project file are defined through properties.") | 182 | As always, the values of the project file are defined through properties.") |
| 184 | 183 | ||
| 185 | (defvar ada-prj-prj-file nil | 184 | (defun ada-quote-cmd (cmd) |
| 186 | "Buffer local variable that specifies the name of the project file. | 185 | "Duplicates all \\ characters in CMD so that it can be passed to `compile'" |
| 187 | Getting the project is done by looking up the key in ada-pxref-project-file.") | 186 | (mapconcat 'identity (split-string cmd "\\\\") "\\\\")) |
| 188 | |||
| 189 | (defun my-local-variable-if-set-p (variable &optional buffer) | ||
| 190 | "Returns t if VARIABLE is local in BUFFER and is non-nil." | ||
| 191 | (and (local-variable-p variable buffer) | ||
| 192 | (save-excursion | ||
| 193 | (set-buffer buffer) | ||
| 194 | (symbol-value variable)))) | ||
| 195 | 187 | ||
| 196 | (defun ada-initialize-runtime-library () | 188 | (defun ada-initialize-runtime-library (cross-prefix) |
| 197 | "Initializes the variables for the runtime library location." | 189 | "Initializes the variables for the runtime library location. |
| 190 | CROSS-PREFIX is the prefix to use for the gnatls command" | ||
| 198 | (save-excursion | 191 | (save-excursion |
| 199 | (set 'ada-xref-runtime-library-specs-path '()) | 192 | (setq ada-xref-runtime-library-specs-path '() |
| 200 | (set 'ada-xref-runtime-library-ali-path '()) | 193 | ada-xref-runtime-library-ali-path '()) |
| 201 | (set-buffer (get-buffer-create "*gnatls*")) | 194 | (set-buffer (get-buffer-create "*gnatls*")) |
| 202 | (widen) | 195 | (widen) |
| 203 | (erase-buffer) | 196 | (erase-buffer) |
| @@ -206,7 +199,8 @@ Getting the project is done by looking up the key in ada-pxref-project-file.") | |||
| 206 | ;; Even if we get an error, delete the *gnatls* buffer | 199 | ;; Even if we get an error, delete the *gnatls* buffer |
| 207 | (unwind-protect | 200 | (unwind-protect |
| 208 | (progn | 201 | (progn |
| 209 | (call-process "gnatls" nil t nil "-v") | 202 | (call-process (concat cross-prefix "gnatls") |
| 203 | nil t nil "-v") | ||
| 210 | (goto-char (point-min)) | 204 | (goto-char (point-min)) |
| 211 | 205 | ||
| 212 | ;; Source path | 206 | ;; Source path |
| @@ -248,23 +242,34 @@ Getting the project is done by looking up the key in ada-pxref-project-file.") | |||
| 248 | "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value. | 242 | "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value. |
| 249 | The project file must have been loaded first. | 243 | The project file must have been loaded first. |
| 250 | As a special case, ${current} is replaced with the name of the currently | 244 | As a special case, ${current} is replaced with the name of the currently |
| 251 | edited file, minus extension but with directory." | 245 | edited file, minus extension but with directory, and ${full_current} is |
| 246 | replaced by the name including the extension." | ||
| 252 | 247 | ||
| 253 | (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string) | 248 | (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string) |
| 254 | (let (value) | 249 | (let (value |
| 255 | (if (string= (match-string 2 cmd-string) "current") | 250 | (name (match-string 2 cmd-string))) |
| 256 | (set 'value (file-name-sans-extension (buffer-file-name))) | 251 | (cond |
| 252 | ((string= name "current") | ||
| 253 | (setq value (file-name-sans-extension (buffer-file-name)))) | ||
| 254 | ((string= name "full_current") | ||
| 255 | (setq value (buffer-file-name))) | ||
| 256 | (t | ||
| 257 | (save-match-data | 257 | (save-match-data |
| 258 | (set 'value (ada-xref-get-project-field | 258 | (setq value (ada-xref-get-project-field (intern name)))))) |
| 259 | (intern (match-string 2 cmd-string)))))) | 259 | |
| 260 | ;; Check if there is an environment variable with the same name | ||
| 261 | (if (null value) | ||
| 262 | (if (not (setq value (getenv name))) | ||
| 263 | (message (concat "No environment variable " name " found")))) | ||
| 264 | |||
| 260 | (cond | 265 | (cond |
| 261 | ((null value) | 266 | ((null value) |
| 262 | (set 'cmd-string (replace-match "" t t cmd-string))) | 267 | (setq cmd-string (replace-match "" t t cmd-string))) |
| 263 | ((stringp value) | 268 | ((stringp value) |
| 264 | (set 'cmd-string (replace-match value t t cmd-string))) | 269 | (setq cmd-string (replace-match value t t cmd-string))) |
| 265 | ((listp value) | 270 | ((listp value) |
| 266 | (let ((prefix (match-string 1 cmd-string))) | 271 | (let ((prefix (match-string 1 cmd-string))) |
| 267 | (set 'cmd-string (replace-match | 272 | (setq cmd-string (replace-match |
| 268 | (mapconcat (lambda(x) (concat prefix x)) value " ") | 273 | (mapconcat (lambda(x) (concat prefix x)) value " ") |
| 269 | t t cmd-string))))) | 274 | t t cmd-string))))) |
| 270 | )) | 275 | )) |
| @@ -282,17 +287,17 @@ edited file, minus extension but with directory." | |||
| 282 | ;; Try hard to find a default value for filename, so that the user | 287 | ;; Try hard to find a default value for filename, so that the user |
| 283 | ;; can edit his project file even if the current buffer is not an | 288 | ;; can edit his project file even if the current buffer is not an |
| 284 | ;; Ada file or not even associated with a file | 289 | ;; Ada file or not even associated with a file |
| 285 | (list 'filename (cond | 290 | (list 'filename (expand-file-name |
| 286 | (file | 291 | (cond |
| 287 | (ada-prj-get-prj-dir file)) | 292 | (file |
| 288 | (ada-prj-prj-file | 293 | (ada-prj-get-prj-dir file)) |
| 289 | ada-prj-prj-file) | 294 | (ada-prj-default-project-file |
| 290 | (ada-xref-default-prj-file | 295 | ada-prj-default-project-file) |
| 291 | ada-xref-default-prj-file) | 296 | (t |
| 292 | (t | 297 | (message (concat "Not editing an Ada file," |
| 293 | (error (concat "Not editing an Ada file," | 298 | "and no default project " |
| 294 | "and no default project " | 299 | "file specified!")) |
| 295 | "file specified!")))) | 300 | ""))) |
| 296 | 'build_dir (file-name-as-directory (expand-file-name ".")) | 301 | 'build_dir (file-name-as-directory (expand-file-name ".")) |
| 297 | 'src_dir (list ".") | 302 | 'src_dir (list ".") |
| 298 | 'obj_dir (list ".") | 303 | 'obj_dir (list ".") |
| @@ -303,8 +308,10 @@ edited file, minus extension but with directory." | |||
| 303 | 'bind_opt ada-prj-default-bind-opt | 308 | 'bind_opt ada-prj-default-bind-opt |
| 304 | 'link_opt ada-prj-default-link-opt | 309 | 'link_opt ada-prj-default-link-opt |
| 305 | 'gnatmake_opt ada-prj-default-gnatmake-opt | 310 | 'gnatmake_opt ada-prj-default-gnatmake-opt |
| 311 | 'gnatfind_opt ada-prj-gnatfind-switches | ||
| 306 | 'main (if file | 312 | 'main (if file |
| 307 | (file-name-sans-extension file) | 313 | (file-name-nondirectory |
| 314 | (file-name-sans-extension file)) | ||
| 308 | "") | 315 | "") |
| 309 | 'main_unit (if file | 316 | 'main_unit (if file |
| 310 | (file-name-nondirectory | 317 | (file-name-nondirectory |
| @@ -312,36 +319,39 @@ edited file, minus extension but with directory." | |||
| 312 | "") | 319 | "") |
| 313 | 'cross_prefix "" | 320 | 'cross_prefix "" |
| 314 | 'remote_machine "" | 321 | 'remote_machine "" |
| 315 | 'comp_cmd (concat "cd ${build_dir} && " | 322 | 'comp_cmd (list (concat ada-cd-command " ${build_dir}") |
| 316 | ada-prj-default-comp-cmd) | 323 | ada-prj-default-comp-cmd) |
| 317 | 'check_cmd (concat ada-prj-default-comp-cmd " " | 324 | 'check_cmd (list (concat ada-prj-default-comp-cmd " " |
| 318 | ada-check-switch) | 325 | ada-check-switch)) |
| 319 | 'make_cmd (concat "cd ${build_dir} && " | 326 | 'make_cmd (list (concat ada-cd-command " ${build_dir}") |
| 320 | ada-prj-default-make-cmd) | 327 | ada-prj-default-make-cmd) |
| 321 | 'run_cmd (concat "cd ${build_dir} && ${main}" | 328 | 'run_cmd (list (concat ada-cd-command " ${build_dir}") |
| 322 | (if is-windows ".exe")) | 329 | (concat "${main}" |
| 330 | (if is-windows ".exe"))) | ||
| 331 | 'debug_pre_cmd (list (concat ada-cd-command | ||
| 332 | " ${build_dir}")) | ||
| 323 | 'debug_cmd (concat ada-prj-default-debugger | 333 | 'debug_cmd (concat ada-prj-default-debugger |
| 324 | (if is-windows " ${main}.exe" | 334 | (if is-windows " ${main}.exe" |
| 325 | " ${main}")))) | 335 | " ${main}")) |
| 336 | 'debug_post_cmd (list nil))) | ||
| 326 | ) | 337 | ) |
| 327 | (set symbol plist))) | 338 | (set symbol plist))) |
| 328 | 339 | ||
| 329 | (defun ada-xref-get-project-field (field) | 340 | (defun ada-xref-get-project-field (field) |
| 330 | "Extract the value of FIELD from the project file of the current buffer. | 341 | "Extract the value of FIELD from the current project file. |
| 331 | The project file must have been loaded first. | 342 | The project file must have been loaded first. |
| 332 | A default value is returned if the file was not found." | 343 | A default value is returned if the file was not found. |
| 344 | |||
| 345 | Note that for src_dir and obj_dir, you should rather use | ||
| 346 | `ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in | ||
| 347 | addition return the default paths." | ||
| 333 | 348 | ||
| 334 | (let ((file-name ada-prj-prj-file) | 349 | (let ((file-name ada-prj-default-project-file) |
| 335 | file value) | 350 | file value) |
| 336 | 351 | ||
| 337 | ;; If a default project file was set, use it if no other project | 352 | ;; Get the project file (either the current one, or a default one) |
| 338 | ;; file was specified for the buffer | 353 | (setq file (or (assoc file-name ada-xref-project-files) |
| 339 | (if (and (not file-name) | 354 | (assoc nil ada-xref-project-files))) |
| 340 | ada-prj-default-project-file | ||
| 341 | (not (string= ada-prj-default-project-file ""))) | ||
| 342 | (set 'file-name ada-prj-default-project-file)) | ||
| 343 | |||
| 344 | (set 'file (assoc file-name ada-xref-project-files)) | ||
| 345 | 355 | ||
| 346 | ;; If the file was not found, use the default values | 356 | ;; If the file was not found, use the default values |
| 347 | (if file | 357 | (if file |
| @@ -351,12 +361,143 @@ A default value is returned if the file was not found." | |||
| 351 | ;; Create a default nil file that contains the default values | 361 | ;; Create a default nil file that contains the default values |
| 352 | (ada-xref-set-default-prj-values 'value (current-buffer)) | 362 | (ada-xref-set-default-prj-values 'value (current-buffer)) |
| 353 | (add-to-list 'ada-xref-project-files (cons nil value)) | 363 | (add-to-list 'ada-xref-project-files (cons nil value)) |
| 364 | (ada-xref-update-project-menu) | ||
| 354 | (set 'value (plist-get value field)) | 365 | (set 'value (plist-get value field)) |
| 355 | ) | 366 | ) |
| 356 | (if (stringp value) | 367 | |
| 357 | (ada-treat-cmd-string value) | 368 | ;; Substitute the ${...} constructs in all the strings, including |
| 358 | value)) | 369 | ;; inside lists |
| 359 | ) | 370 | (cond |
| 371 | ((stringp value) | ||
| 372 | (ada-treat-cmd-string value)) | ||
| 373 | ((null value) | ||
| 374 | nil) | ||
| 375 | ((listp value) | ||
| 376 | (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value)) | ||
| 377 | (t | ||
| 378 | value) | ||
| 379 | ) | ||
| 380 | )) | ||
| 381 | |||
| 382 | |||
| 383 | (defun ada-xref-get-src-dir-field () | ||
| 384 | "Return the full value for src_dir, including the default directories. | ||
| 385 | All the directories are returned as absolute directories." | ||
| 386 | |||
| 387 | (let ((build-dir (ada-xref-get-project-field 'build_dir))) | ||
| 388 | (append | ||
| 389 | ;; Add ${build_dir} in front of the path | ||
| 390 | (list build-dir) | ||
| 391 | |||
| 392 | (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) | ||
| 393 | build-dir) | ||
| 394 | |||
| 395 | ;; Add the standard runtime at the end | ||
| 396 | ada-xref-runtime-library-specs-path))) | ||
| 397 | |||
| 398 | (defun ada-xref-get-obj-dir-field () | ||
| 399 | "Return the full value for obj_dir, including the default directories. | ||
| 400 | All the directories are returned as absolute directories." | ||
| 401 | |||
| 402 | (let ((build-dir (ada-xref-get-project-field 'build_dir))) | ||
| 403 | (append | ||
| 404 | ;; Add ${build_dir} in front of the path | ||
| 405 | (list build-dir) | ||
| 406 | |||
| 407 | (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir) | ||
| 408 | build-dir) | ||
| 409 | |||
| 410 | ;; Add the standard runtime at the end | ||
| 411 | ada-xref-runtime-library-ali-path))) | ||
| 412 | |||
| 413 | (defun ada-xref-update-project-menu () | ||
| 414 | "Update the menu Ada->Project, with the list of available project files." | ||
| 415 | (interactive) | ||
| 416 | (let (submenu) | ||
| 417 | |||
| 418 | ;; Create the standard items | ||
| 419 | (set 'submenu (list (cons 'Load (cons "Load..." | ||
| 420 | 'ada-set-default-project-file)) | ||
| 421 | (cons 'New (cons "New..." 'ada-prj-new)) | ||
| 422 | (cons 'Edit (cons "Edit..." 'ada-prj-edit)) | ||
| 423 | (cons 'sep (cons "---" nil)))) | ||
| 424 | |||
| 425 | ;; Add the new items | ||
| 426 | (mapcar | ||
| 427 | (lambda (x) | ||
| 428 | (let ((name (or (car x) "<default>")) | ||
| 429 | (command `(lambda () | ||
| 430 | "Change the active project file." | ||
| 431 | (interactive) | ||
| 432 | (ada-parse-prj-file ,(car x)) | ||
| 433 | (set 'ada-prj-default-project-file ,(car x)) | ||
| 434 | (ada-xref-update-project-menu)))) | ||
| 435 | (set 'submenu | ||
| 436 | (append submenu | ||
| 437 | (list (cons (intern name) | ||
| 438 | (list | ||
| 439 | 'menu-item (file-name-sans-extension | ||
| 440 | (file-name-nondirectory name)) | ||
| 441 | command | ||
| 442 | :button (cons | ||
| 443 | :toggle | ||
| 444 | (equal ada-prj-default-project-file | ||
| 445 | (car x)) | ||
| 446 | )))))))) | ||
| 447 | |||
| 448 | ;; Parses all the known project files, and insert at least the default | ||
| 449 | ;; one (in case ada-xref-project-files is nil) | ||
| 450 | (or ada-xref-project-files '(nil))) | ||
| 451 | |||
| 452 | (if (not ada-xemacs) | ||
| 453 | (if (lookup-key ada-mode-map [menu-bar Ada Project]) | ||
| 454 | (setcdr (lookup-key ada-mode-map [menu-bar Ada Project]) | ||
| 455 | submenu))) | ||
| 456 | )) | ||
| 457 | |||
| 458 | |||
| 459 | ;;------------------------------------------------------------- | ||
| 460 | ;;-- Searching a file anywhere on the source path. | ||
| 461 | ;;-- | ||
| 462 | ;;-- The following functions provide support for finding a file anywhere | ||
| 463 | ;;-- on the source path, without providing an explicit directory. | ||
| 464 | ;;-- They also provide file name completion in the minibuffer. | ||
| 465 | ;;-- | ||
| 466 | ;;-- Public subprograms: ada-find-file | ||
| 467 | ;;-- | ||
| 468 | ;;------------------------------------------------------------- | ||
| 469 | |||
| 470 | (defun ada-do-file-completion (string predicate flag) | ||
| 471 | "Completion function when reading a file from the minibuffer. | ||
| 472 | Completion is attempted in all the directories in the source path, as | ||
| 473 | defined in the project file." | ||
| 474 | (let (list | ||
| 475 | (dirs (ada-xref-get-src-dir-field))) | ||
| 476 | |||
| 477 | (while dirs | ||
| 478 | (if (file-directory-p (car dirs)) | ||
| 479 | (set 'list (append list (file-name-all-completions string (car dirs))))) | ||
| 480 | (set 'dirs (cdr dirs))) | ||
| 481 | (cond ((equal flag 'lambda) | ||
| 482 | (assoc string list)) | ||
| 483 | (flag | ||
| 484 | list) | ||
| 485 | (t | ||
| 486 | (try-completion string | ||
| 487 | (mapcar (lambda (x) (cons x 1)) list) | ||
| 488 | predicate))))) | ||
| 489 | |||
| 490 | ;;;###autoload | ||
| 491 | (defun ada-find-file (filename) | ||
| 492 | "Open a file anywhere in the source path. | ||
| 493 | Completion is available." | ||
| 494 | (interactive | ||
| 495 | (list (completing-read "File: " 'ada-do-file-completion))) | ||
| 496 | (let ((file (ada-find-src-file-in-dir filename))) | ||
| 497 | (if file | ||
| 498 | (find-file file) | ||
| 499 | (error (concat filename " not found in src_dir"))))) | ||
| 500 | |||
| 360 | 501 | ||
| 361 | ;; ----- Keybindings ------------------------------------------------------ | 502 | ;; ----- Keybindings ------------------------------------------------------ |
| 362 | 503 | ||
| @@ -376,14 +517,14 @@ A default value is returned if the file was not found." | |||
| 376 | (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) | 517 | (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) |
| 377 | (define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file) | 518 | (define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file) |
| 378 | (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) | 519 | (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) |
| 379 | (define-key ada-mode-map "\C-cb" 'ada-buffer-list) | ||
| 380 | (define-key ada-mode-map "\C-cc" 'ada-change-prj) | 520 | (define-key ada-mode-map "\C-cc" 'ada-change-prj) |
| 381 | (define-key ada-mode-map "\C-cd" 'ada-change-default-prj) | 521 | (define-key ada-mode-map "\C-cd" 'ada-set-default-project-file) |
| 382 | (define-key ada-mode-map "\C-cg" 'ada-gdb-application) | 522 | (define-key ada-mode-map "\C-cg" 'ada-gdb-application) |
| 383 | (define-key ada-mode-map "\C-cr" 'ada-run-application) | 523 | (define-key ada-mode-map "\C-cr" 'ada-run-application) |
| 384 | (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) | 524 | (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) |
| 385 | (define-key ada-mode-map "\C-c\C-r" 'ada-find-references) | 525 | (define-key ada-mode-map "\C-c\C-r" 'ada-find-references) |
| 386 | (define-key ada-mode-map "\C-c\C-v" 'ada-check-current) | 526 | (define-key ada-mode-map "\C-c\C-v" 'ada-check-current) |
| 527 | (define-key ada-mode-map "\C-c\C-f" 'ada-find-file) | ||
| 387 | ) | 528 | ) |
| 388 | 529 | ||
| 389 | ;; ----- Menus -------------------------------------------------------------- | 530 | ;; ----- Menus -------------------------------------------------------------- |
| @@ -412,12 +553,6 @@ name as was passed to `ada-create-menu'." | |||
| 412 | menu-list ["Debug" ada-gdb-application t] "Goto") | 553 | menu-list ["Debug" ada-gdb-application t] "Goto") |
| 413 | (funcall (symbol-function 'add-menu-button) | 554 | (funcall (symbol-function 'add-menu-button) |
| 414 | menu-list ["--" nil t] "Goto") | 555 | menu-list ["--" nil t] "Goto") |
| 415 | (funcall (symbol-function 'add-submenu) | ||
| 416 | menu-list '("Project" | ||
| 417 | ["Associate" ada-change-prj t] | ||
| 418 | ["Set Default..." ada-set-default-project-file t] | ||
| 419 | ["List" ada-buffer-list t]) | ||
| 420 | "Goto") | ||
| 421 | (funcall (symbol-function 'add-menu-button) | 556 | (funcall (symbol-function 'add-menu-button) |
| 422 | goto-menu ["Goto Parent Unit" ada-goto-parent t] | 557 | goto-menu ["Goto Parent Unit" ada-goto-parent t] |
| 423 | "Next compilation error") | 558 | "Next compilation error") |
| @@ -475,6 +610,13 @@ name as was passed to `ada-create-menu'." | |||
| 475 | (setq ada-xref-confirm-compile | 610 | (setq ada-xref-confirm-compile |
| 476 | (not ada-xref-confirm-compile)) | 611 | (not ada-xref-confirm-compile)) |
| 477 | :style toggle :selected ada-xref-confirm-compile]) | 612 | :style toggle :selected ada-xref-confirm-compile]) |
| 613 | (if (string-match "gvd" ada-prj-default-debugger) | ||
| 614 | (funcall (symbol-function 'add-menu-button) | ||
| 615 | options-menu | ||
| 616 | ["Tight Integration With Gnu Visual Debugger" | ||
| 617 | (setq ada-tight-gvd-integration | ||
| 618 | (not ada-tight-gvd-integration)) | ||
| 619 | :style toggle :selected ada-tight-gvd-integration])) | ||
| 478 | ) | 620 | ) |
| 479 | 621 | ||
| 480 | ;; for Emacs | 622 | ;; for Emacs |
| @@ -494,14 +636,7 @@ name as was passed to `ada-create-menu'." | |||
| 494 | (define-key-after menu [Debug] '("Debug" . ada-gdb-application) 'Run) | 636 | (define-key-after menu [Debug] '("Debug" . ada-gdb-application) 'Run) |
| 495 | (define-key-after menu [rem] '("--" . nil) 'Debug) | 637 | (define-key-after menu [rem] '("--" . nil) 'Debug) |
| 496 | (define-key-after menu [Project] | 638 | (define-key-after menu [Project] |
| 497 | (cons "Project" | 639 | (cons "Project" (make-sparse-keymap)) 'rem) |
| 498 | (funcall (symbol-function 'easy-menu-create-menu) | ||
| 499 | "Project" | ||
| 500 | '(["Associate..." ada-change-prj t | ||
| 501 | :included (string= mode-name "Ada")] | ||
| 502 | ["Set Default..." ada-set-default-project-file t] | ||
| 503 | ["List" ada-buffer-list t]))) | ||
| 504 | 'rem) | ||
| 505 | 640 | ||
| 506 | (define-key help-menu [Gnat_ug] | 641 | (define-key help-menu [Gnat_ug] |
| 507 | '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug")))) | 642 | '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug")))) |
| @@ -511,7 +646,7 @@ name as was passed to `ada-create-menu'." | |||
| 511 | '("Gcc Documentation" . (lambda() (interactive) (info "gcc")))) | 646 | '("Gcc Documentation" . (lambda() (interactive) (info "gcc")))) |
| 512 | (define-key help-menu [gdb] | 647 | (define-key help-menu [gdb] |
| 513 | '("Gdb Documentation" . (lambda() (interactive) (info "gdb")))) | 648 | '("Gdb Documentation" . (lambda() (interactive) (info "gdb")))) |
| 514 | (define-key help-menu [gdb] | 649 | (define-key help-menu [arm95] |
| 515 | '("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95")))) | 650 | '("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95")))) |
| 516 | 651 | ||
| 517 | (define-key goto-menu [rem] '("----" . nil)) | 652 | (define-key goto-menu [rem] '("----" . nil)) |
| @@ -548,15 +683,30 @@ name as was passed to `ada-create-menu'." | |||
| 548 | (lambda()(interactive) | 683 | (lambda()(interactive) |
| 549 | (setq ada-xref-other-buffer (not ada-xref-other-buffer))) | 684 | (setq ada-xref-other-buffer (not ada-xref-other-buffer))) |
| 550 | :button (:toggle . ada-xref-other-buffer)) t) | 685 | :button (:toggle . ada-xref-other-buffer)) t) |
| 686 | |||
| 687 | (if (string-match "gvd" ada-prj-default-debugger) | ||
| 688 | (define-key-after options-menu [tightgvd] | ||
| 689 | '(menu-item "Tight Integration With Gnu Visual Debugger" | ||
| 690 | (lambda()(interactive) | ||
| 691 | (setq ada-tight-gvd-integration | ||
| 692 | (not ada-tight-gvd-integration))) | ||
| 693 | :button (:toggle . ada-tight-gvd-integration)) t)) | ||
| 694 | |||
| 695 | (define-key ada-mode-map [menu-bar Ada Edit rem3] '("------------" . nil)) | ||
| 696 | (define-key ada-mode-map [menu-bar Ada Edit open-file-from-src-path] | ||
| 697 | '("Search File on source path..." . ada-find-file)) | ||
| 551 | ) | 698 | ) |
| 552 | ) | 699 | ) |
| 700 | (ada-xref-update-project-menu) | ||
| 553 | ) | 701 | ) |
| 554 | 702 | ||
| 555 | ;; ----- Utilities ------------------------------------------------- | 703 | ;; ----- Utilities ------------------------------------------------- |
| 556 | 704 | ||
| 557 | (defun ada-require-project-file () | 705 | (defun ada-require-project-file () |
| 558 | "If no project file is assigned to this buffer, load one." | 706 | "If no project file is currently active, load a default one." |
| 559 | (if (not (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))) | 707 | (if (or (not ada-prj-default-project-file) |
| 708 | (not ada-xref-project-files) | ||
| 709 | (string= ada-prj-default-project-file "")) | ||
| 560 | (ada-reread-prj-file))) | 710 | (ada-reread-prj-file))) |
| 561 | 711 | ||
| 562 | (defun ada-xref-push-pos (filename position) | 712 | (defun ada-xref-push-pos (filename position) |
| @@ -582,18 +732,7 @@ This is overriden on VMS to convert from VMS filenames to Unix filenames." | |||
| 582 | (defun ada-set-default-project-file (name) | 732 | (defun ada-set-default-project-file (name) |
| 583 | "Set the file whose name is NAME as the default project file." | 733 | "Set the file whose name is NAME as the default project file." |
| 584 | (interactive "fProject file:") | 734 | (interactive "fProject file:") |
| 585 | |||
| 586 | ;; All the directories should use this file as the default from now on, | ||
| 587 | ;; even if they were already associated with a file. | ||
| 588 | (set 'ada-xref-default-prj-file nil) | ||
| 589 | |||
| 590 | (set 'ada-prj-default-project-file name) | 735 | (set 'ada-prj-default-project-file name) |
| 591 | |||
| 592 | ;; Make sure that all the buffers see the new project file, even if they | ||
| 593 | ;; are not Ada buffers (for instance if we want to display the current | ||
| 594 | ;; project file in the frame title). | ||
| 595 | (setq-default ada-prj-prj-file name) | ||
| 596 | |||
| 597 | (ada-reread-prj-file name) | 736 | (ada-reread-prj-file name) |
| 598 | ) | 737 | ) |
| 599 | 738 | ||
| @@ -608,90 +747,81 @@ file. If none is set, return nil." | |||
| 608 | 747 | ||
| 609 | (let (selected) | 748 | (let (selected) |
| 610 | 749 | ||
| 611 | ;; If we don't have an ada buffer, or the current buffer is not | 750 | ;; Use the active project file if there is one. |
| 612 | ;; a real file (for instance an emerge buffer) | 751 | ;; This is also valid if we don't currently have an Ada buffer, or if |
| 752 | ;; the current buffer is not a real file (for instance an emerge buffer) | ||
| 613 | 753 | ||
| 614 | (if (or (not (string= mode-name "Ada")) | 754 | (if (or (not (string= mode-name "Ada")) |
| 615 | (not (buffer-file-name))) | 755 | (not (buffer-file-name)) |
| 616 | 756 | (and ada-prj-default-project-file | |
| 617 | ;; 1st case: not an Ada buffer | 757 | (not (string= ada-prj-default-project-file "")))) |
| 618 | (if (and ada-prj-default-project-file | 758 | (set 'selected ada-prj-default-project-file) |
| 619 | (not (string= ada-prj-default-project-file ""))) | 759 | |
| 620 | (set 'selected ada-prj-default-project-file)) | 760 | ;; other cases: use a more complex algorithm |
| 621 | 761 | ||
| 622 | ;; 2nd case: If the buffer already has a project file, use it | 762 | (let* ((current-file (buffer-file-name)) |
| 623 | (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)) | 763 | (first-choice (concat |
| 624 | (set 'selected ada-prj-prj-file) | 764 | (file-name-sans-extension current-file) |
| 765 | ada-project-file-extension)) | ||
| 766 | (dir (file-name-directory current-file)) | ||
| 767 | |||
| 768 | ;; on Emacs 20.2, directory-files does not work if | ||
| 769 | ;; parse-sexp-lookup-properties is set | ||
| 770 | (parse-sexp-lookup-properties nil) | ||
| 771 | (prj-files (directory-files | ||
| 772 | dir t | ||
| 773 | (concat ".*" (regexp-quote | ||
| 774 | ada-project-file-extension) "$"))) | ||
| 775 | (choice nil)) | ||
| 625 | 776 | ||
| 626 | (let* ((current-file (buffer-file-name)) | 777 | (cond |
| 627 | (first-choice (concat | 778 | |
| 628 | (file-name-sans-extension current-file) | 779 | ;; Else if there is a project file with the same name as the Ada |
| 629 | ada-project-file-extension)) | 780 | ;; file, but not the same extension. |
| 630 | (dir (file-name-directory current-file)) | 781 | ((file-exists-p first-choice) |
| 631 | 782 | (set 'selected first-choice)) | |
| 632 | ;; on Emacs 20.2, directory-files does not work if | 783 | |
| 633 | ;; parse-sexp-lookup-properties is set | 784 | ;; Else if only one project file was found in the current directory |
| 634 | (parse-sexp-lookup-properties nil) | 785 | ((= (length prj-files) 1) |
| 635 | (prj-files (directory-files | 786 | (set 'selected (car prj-files))) |
| 636 | dir t | 787 | |
| 637 | (concat ".*" (regexp-quote ada-project-file-extension) "$"))) | 788 | ;; Else if there are multiple files, ask the user |
| 638 | (choice nil) | 789 | ((and (> (length prj-files) 1) (not no-user-question)) |
| 639 | (default (assoc dir ada-xref-default-prj-file))) | 790 | (save-window-excursion |
| 640 | 791 | (with-output-to-temp-buffer "*choice list*" | |
| 641 | (cond | 792 | (princ "There are more than one possible project file.\n") |
| 642 | 793 | (princ "Which one should we use ?\n\n") | |
| 643 | ;; 3rd case: a project file is already associated with the directory | 794 | (princ " no. file name \n") |
| 644 | (default | 795 | (princ " --- ------------------------\n") |
| 645 | (set 'selected (cdr default))) | 796 | (let ((counter 1)) |
| 646 | 797 | (while (<= counter (length prj-files)) | |
| 647 | ;; 4th case: the user has set a default project file for every file | 798 | (princ (format " %2d) %s\n" |
| 648 | ((and ada-prj-default-project-file | 799 | counter |
| 649 | (not (string= ada-prj-default-project-file ""))) | 800 | (nth (1- counter) prj-files))) |
| 650 | (set 'selected ada-prj-default-project-file)) | 801 | (setq counter (1+ counter)) |
| 651 | 802 | ))) ; end of with-output-to ... | |
| 652 | ;; 5th case: there is a project file with the same name as the Ada file, | 803 | (setq choice nil) |
| 653 | ;; but not the same extension. | 804 | (while (or |
| 654 | ((file-exists-p first-choice) | 805 | (not choice) |
| 655 | (set 'selected first-choice)) | 806 | (not (integerp choice)) |
| 656 | 807 | (< choice 1) | |
| 657 | ;; 6th case: only one project file was found in the current directory | 808 | (> choice (length prj-files))) |
| 658 | ((= (length prj-files) 1) | 809 | (setq choice (string-to-int |
| 659 | (set 'selected (car prj-files))) | 810 | (read-from-minibuffer "Enter No. of your choice: ")))) |
| 660 | 811 | (set 'selected (nth (1- choice) prj-files)))) | |
| 661 | ;; 7th case: if there are multiple files, ask the user | 812 | |
| 662 | ((and (> (length prj-files) 1) (not no-user-question)) | 813 | ;; Else if no project file was found in the directory, ask a name |
| 663 | (save-window-excursion | 814 | ;; to the user, using as a default value the last one entered by |
| 664 | (with-output-to-temp-buffer "*choice list*" | 815 | ;; the user |
| 665 | (princ "There are more than one possible project file. Which one should\n") | 816 | ((= (length prj-files) 0) |
| 666 | (princ "be used ?\n\n") | 817 | (unless (or no-user-question (not ada-always-ask-project)) |
| 667 | (princ " no. file name \n") | 818 | (setq ada-last-prj-file |
| 668 | (princ " --- ------------------------\n") | 819 | (read-file-name |
| 669 | (let ((counter 1)) | 820 | (concat "project file [" ada-last-prj-file "]:") |
| 670 | (while (<= counter (length prj-files)) | 821 | nil ada-last-prj-file)) |
| 671 | (princ (format " %2d) %s\n" | 822 | (unless (string= ada-last-prj-file "") |
| 672 | counter | 823 | (set 'selected ada-last-prj-file)))) |
| 673 | (nth (1- counter) prj-files))) | 824 | ))) |
| 674 | (setq counter (1+ counter)) | ||
| 675 | ))) ; end of with-output-to ... | ||
| 676 | (setq choice nil) | ||
| 677 | (while (or | ||
| 678 | (not choice) | ||
| 679 | (not (integerp choice)) | ||
| 680 | (< choice 1) | ||
| 681 | (> choice (length prj-files))) | ||
| 682 | (setq choice (string-to-int | ||
| 683 | (read-from-minibuffer "Enter No. of your choice: ")))) | ||
| 684 | (set 'selected (nth (1- choice) prj-files)))) | ||
| 685 | |||
| 686 | ;; 8th case: no project file was found in the directory, ask a name to the | ||
| 687 | ;; user, using as a default value the last one entered by the user | ||
| 688 | ((= (length prj-files) 0) | ||
| 689 | (unless (or no-user-question (not ada-always-ask-project)) | ||
| 690 | (setq ada-last-prj-file | ||
| 691 | (read-file-name "project file:" nil ada-last-prj-file)) | ||
| 692 | (unless (string= ada-last-prj-file "") | ||
| 693 | (set 'selected ada-last-prj-file)))) | ||
| 694 | )))) | ||
| 695 | selected | 825 | selected |
| 696 | )) | 826 | )) |
| 697 | 827 | ||
| @@ -700,9 +830,10 @@ file. If none is set, return nil." | |||
| 700 | "Reads and parses the PRJ-FILE file if it was found. | 830 | "Reads and parses the PRJ-FILE file if it was found. |
| 701 | The current buffer should be the ada-file buffer." | 831 | The current buffer should be the ada-file buffer." |
| 702 | (if prj-file | 832 | (if prj-file |
| 703 | (let (project src_dir obj_dir casing | 833 | (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing |
| 834 | run_cmd debug_pre_cmd debug_post_cmd | ||
| 704 | (ada-buffer (current-buffer))) | 835 | (ada-buffer (current-buffer))) |
| 705 | (set 'prj-file (expand-file-name prj-file)) | 836 | (setq prj-file (expand-file-name prj-file)) |
| 706 | 837 | ||
| 707 | ;; Initialize the project with the default values | 838 | ;; Initialize the project with the default values |
| 708 | (ada-xref-set-default-prj-values 'project (current-buffer)) | 839 | (ada-xref-set-default-prj-values 'project (current-buffer)) |
| @@ -716,7 +847,7 @@ The current buffer should be the ada-file buffer." | |||
| 716 | 847 | ||
| 717 | (widen) | 848 | (widen) |
| 718 | (goto-char (point-min)) | 849 | (goto-char (point-min)) |
| 719 | 850 | ||
| 720 | ;; Now overrides these values with the project file | 851 | ;; Now overrides these values with the project file |
| 721 | (while (not (eobp)) | 852 | (while (not (eobp)) |
| 722 | (if (looking-at "^\\([^=]+\\)=\\(.*\\)") | 853 | (if (looking-at "^\\([^=]+\\)=\\(.*\\)") |
| @@ -733,6 +864,18 @@ The current buffer should be the ada-file buffer." | |||
| 733 | (set 'project | 864 | (set 'project |
| 734 | (plist-put project 'build_dir | 865 | (plist-put project 'build_dir |
| 735 | (file-name-as-directory (match-string 2))))) | 866 | (file-name-as-directory (match-string 2))))) |
| 867 | ((string= (match-string 1) "make_cmd") | ||
| 868 | (add-to-list 'make_cmd (match-string 2))) | ||
| 869 | ((string= (match-string 1) "comp_cmd") | ||
| 870 | (add-to-list 'comp_cmd (match-string 2))) | ||
| 871 | ((string= (match-string 1) "check_cmd") | ||
| 872 | (add-to-list 'check_cmd (match-string 2))) | ||
| 873 | ((string= (match-string 1) "run_cmd") | ||
| 874 | (add-to-list 'run_cmd (match-string 2))) | ||
| 875 | ((string= (match-string 1) "debug_pre_cmd") | ||
| 876 | (add-to-list 'debug_pre_cmd (match-string 2))) | ||
| 877 | ((string= (match-string 1) "debug_post_cmd") | ||
| 878 | (add-to-list 'debug_post_cmd (match-string 2))) | ||
| 736 | (t | 879 | (t |
| 737 | (set 'project (plist-put project (intern (match-string 1)) | 880 | (set 'project (plist-put project (intern (match-string 1)) |
| 738 | (match-string 2)))))) | 881 | (match-string 2)))))) |
| @@ -742,31 +885,48 @@ The current buffer should be the ada-file buffer." | |||
| 742 | (reverse src_dir)))) | 885 | (reverse src_dir)))) |
| 743 | (if obj_dir (set 'project (plist-put project 'obj_dir | 886 | (if obj_dir (set 'project (plist-put project 'obj_dir |
| 744 | (reverse obj_dir)))) | 887 | (reverse obj_dir)))) |
| 745 | (if casing (set 'project (plist-put project 'casing casing))) | 888 | (if casing (set 'project (plist-put project 'casing |
| 746 | 889 | (reverse casing)))) | |
| 890 | (if make_cmd (set 'project (plist-put project 'make_cmd | ||
| 891 | (reverse make_cmd)))) | ||
| 892 | (if comp_cmd (set 'project (plist-put project 'comp_cmd | ||
| 893 | (reverse comp_cmd)))) | ||
| 894 | (if check_cmd (set 'project (plist-put project 'check_cmd | ||
| 895 | (reverse check_cmd)))) | ||
| 896 | (if run_cmd (set 'project (plist-put project 'run_cmd | ||
| 897 | (reverse run_cmd)))) | ||
| 898 | (set 'project (plist-put project 'debug_post_cmd | ||
| 899 | (reverse debug_post_cmd))) | ||
| 900 | (set 'project (plist-put project 'debug_pre_cmd | ||
| 901 | (reverse debug_pre_cmd))) | ||
| 902 | |||
| 903 | ;; Delete the default project file from the list, if it is there. | ||
| 904 | ;; Note that in that case, this default project is the only one in | ||
| 905 | ;; the list | ||
| 906 | (if (assoc nil ada-xref-project-files) | ||
| 907 | (setq ada-xref-project-files nil)) | ||
| 908 | |||
| 747 | ;; Memorize the newly read project file | 909 | ;; Memorize the newly read project file |
| 748 | (if (assoc prj-file ada-xref-project-files) | 910 | (if (assoc prj-file ada-xref-project-files) |
| 749 | (setcdr (assoc prj-file ada-xref-project-files) project) | 911 | (setcdr (assoc prj-file ada-xref-project-files) project) |
| 750 | (add-to-list 'ada-xref-project-files (cons prj-file project))) | 912 | (add-to-list 'ada-xref-project-files (cons prj-file project))) |
| 913 | |||
| 914 | ;; Set the project file as the active one. | ||
| 915 | (setq ada-prj-default-project-file prj-file) | ||
| 751 | 916 | ||
| 752 | ;; Sets up the compilation-search-path so that Emacs is able to | 917 | ;; Sets up the compilation-search-path so that Emacs is able to |
| 753 | ;; go to the source of the errors in a compilation buffer | 918 | ;; go to the source of the errors in a compilation buffer |
| 754 | (setq compilation-search-path (ada-get-absolute-dir-list | 919 | (setq compilation-search-path (ada-xref-get-src-dir-field)) |
| 755 | (plist-get project 'src_dir) | 920 | |
| 756 | (plist-get project 'build_dir))) | 921 | ;; Set the casing exceptions file list |
| 757 | 922 | (if casing | |
| 758 | ;; Associate each source directory in the project file with this file | 923 | (progn |
| 759 | (mapcar (lambda (x) | 924 | (setq ada-case-exception-file (reverse casing)) |
| 760 | (if (not (assoc (expand-file-name x) | 925 | (ada-case-read-exceptions))) |
| 761 | ada-xref-default-prj-file)) | ||
| 762 | (setq ada-xref-default-prj-file | ||
| 763 | (cons (cons (expand-file-name x) prj-file) | ||
| 764 | ada-xref-default-prj-file)))) | ||
| 765 | compilation-search-path) | ||
| 766 | 926 | ||
| 767 | ;; Add the directories to the search path for ff-find-other-file | 927 | ;; Add the directories to the search path for ff-find-other-file |
| 768 | ;; Do not add the '/' or '\' at the end | 928 | ;; Do not add the '/' or '\' at the end |
| 769 | (set (make-local-variable 'ff-search-directories) | 929 | (setq ada-search-directories |
| 770 | (append (mapcar 'directory-file-name compilation-search-path) | 930 | (append (mapcar 'directory-file-name compilation-search-path) |
| 771 | ada-search-directories)) | 931 | ada-search-directories)) |
| 772 | 932 | ||
| @@ -774,10 +934,15 @@ The current buffer should be the ada-file buffer." | |||
| 774 | (kill-buffer nil) | 934 | (kill-buffer nil) |
| 775 | (set-buffer ada-buffer) | 935 | (set-buffer ada-buffer) |
| 776 | 936 | ||
| 777 | ;; Setup the project file for the current buffer | 937 | (ada-xref-update-project-menu) |
| 778 | (set (make-local-variable 'ada-prj-prj-file) prj-file) | ||
| 779 | |||
| 780 | ) | 938 | ) |
| 939 | |||
| 940 | ;; No prj file ? => Setup default values | ||
| 941 | ;; Note that nil means that all compilation modes will first look in the | ||
| 942 | ;; current directory, and only then in the current file's directory. This | ||
| 943 | ;; current file is assumed at this point to be in the common source | ||
| 944 | ;; directory. | ||
| 945 | (setq compilation-search-path (list nil default-directory)) | ||
| 781 | )) | 946 | )) |
| 782 | 947 | ||
| 783 | 948 | ||
| @@ -813,14 +978,26 @@ ENTITY was first found the location given by FILE, LINE and COLUMN." | |||
| 813 | (interactive "sEntity name: ") | 978 | (interactive "sEntity name: ") |
| 814 | (ada-require-project-file) | 979 | (ada-require-project-file) |
| 815 | 980 | ||
| 816 | (let* ((command (concat "gnatfind -rf " entity | 981 | ;; Prepare the gnatfind command. Note that we must protect the quotes |
| 982 | ;; around operators, so that they are correctly handled and can be | ||
| 983 | ;; processed (gnatfind \"+\":...). | ||
| 984 | (let* ((quote-entity | ||
| 985 | (if (= (aref entity 0) ?\") | ||
| 986 | (if is-windows | ||
| 987 | (concat "\\\"" (substring entity 1 -1) "\\\"") | ||
| 988 | (concat "'\"" (substring entity 1 -1) "\"'")) | ||
| 989 | entity)) | ||
| 990 | (switches (ada-xref-get-project-field 'gnatfind_opt)) | ||
| 991 | (command (concat "gnatfind " switches " " | ||
| 992 | quote-entity | ||
| 817 | (if file (concat ":" (file-name-nondirectory file))) | 993 | (if file (concat ":" (file-name-nondirectory file))) |
| 818 | (if line (concat ":" line)) | 994 | (if line (concat ":" line)) |
| 819 | (if column (concat ":" column))))) | 995 | (if column (concat ":" column))))) |
| 820 | 996 | ||
| 821 | ;; If a project file is defined, use it | 997 | ;; If a project file is defined, use it |
| 822 | (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)) | 998 | (if (and ada-prj-default-project-file |
| 823 | (setq command (concat command " -p" ada-prj-prj-file))) | 999 | (not (string= ada-prj-default-project-file ""))) |
| 1000 | (setq command (concat command " -p" ada-prj-default-project-file))) | ||
| 824 | 1001 | ||
| 825 | (compile-internal command "No more references" "gnatfind") | 1002 | (compile-internal command "No more references" "gnatfind") |
| 826 | 1003 | ||
| @@ -831,83 +1008,7 @@ ENTITY was first found the location given by FILE, LINE and COLUMN." | |||
| 831 | ) | 1008 | ) |
| 832 | ) | 1009 | ) |
| 833 | 1010 | ||
| 834 | (defun ada-buffer-list () | 1011 | (defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file)) |
| 835 | "Display a buffer with all the Ada buffers and their associated project." | ||
| 836 | (interactive) | ||
| 837 | (save-excursion | ||
| 838 | (set-buffer (get-buffer-create "*Buffer List*")) | ||
| 839 | (setq buffer-read-only nil) | ||
| 840 | (erase-buffer) | ||
| 841 | (setq standard-output (current-buffer)) | ||
| 842 | (princ "The following line is a list showing the associations between | ||
| 843 | directories and project file. It has the format : ((directory_1 . project_file1) | ||
| 844 | (directory2 . project_file2)...)\n\n") | ||
| 845 | (princ ada-xref-default-prj-file) | ||
| 846 | (princ "\n | ||
| 847 | Buffer Mode Project file | ||
| 848 | ------ ---- ------------ | ||
| 849 | \n") | ||
| 850 | (let ((bl (buffer-list))) | ||
| 851 | (while bl | ||
| 852 | (let* ((buffer (car bl)) | ||
| 853 | (buffer-name (buffer-name buffer)) | ||
| 854 | this-buffer-mode-name | ||
| 855 | this-buffer-project-file) | ||
| 856 | (save-excursion | ||
| 857 | (set-buffer buffer) | ||
| 858 | (setq this-buffer-mode-name | ||
| 859 | (if (eq buffer standard-output) | ||
| 860 | "Buffer Menu" mode-name)) | ||
| 861 | (if (string= this-buffer-mode-name | ||
| 862 | "Ada") | ||
| 863 | (setq this-buffer-project-file | ||
| 864 | (if ( my-local-variable-if-set-p 'ada-prj-prj-file | ||
| 865 | (current-buffer)) | ||
| 866 | (expand-file-name ada-prj-prj-file) | ||
| 867 | "")))) | ||
| 868 | (if (string= this-buffer-mode-name | ||
| 869 | "Ada") | ||
| 870 | (progn | ||
| 871 | (princ (format "%-19s " buffer-name)) | ||
| 872 | (princ (format "%-6s " this-buffer-mode-name)) | ||
| 873 | (princ this-buffer-project-file) | ||
| 874 | (princ "\n") | ||
| 875 | )) | ||
| 876 | ) ;; end let* | ||
| 877 | (setq bl (cdr bl)) | ||
| 878 | ) ;; end while | ||
| 879 | );; end let | ||
| 880 | ) ;; end save-excursion | ||
| 881 | (display-buffer "*Buffer List*") | ||
| 882 | (other-window 1) | ||
| 883 | ) | ||
| 884 | |||
| 885 | (defun ada-change-prj (filename) | ||
| 886 | "Set FILENAME to be the project file for current buffer." | ||
| 887 | (interactive "fproject file:") | ||
| 888 | |||
| 889 | ;; make sure we are using an Ada file | ||
| 890 | (if (not (string= mode-name "Ada")) | ||
| 891 | (error "You must be in ada-mode to use this function")) | ||
| 892 | |||
| 893 | (set (make-local-variable 'ada-prj-prj-file) filename) | ||
| 894 | (ada-parse-prj-file filename) | ||
| 895 | ) | ||
| 896 | |||
| 897 | (defun ada-change-default-prj (filename) | ||
| 898 | "Set FILENAME to be the default project file for the current directory." | ||
| 899 | (interactive "ffile name:") | ||
| 900 | (let ((dir (file-name-directory (buffer-file-name))) | ||
| 901 | (prj (expand-file-name filename))) | ||
| 902 | |||
| 903 | ;; Associate the directory with a project file | ||
| 904 | (if (assoc dir ada-xref-default-prj-file) | ||
| 905 | (setcdr (assoc dir ada-xref-default-prj-file) prj) | ||
| 906 | (add-to-list 'ada-xref-default-prj-file (list dir prj))) | ||
| 907 | |||
| 908 | ;; Reparse the project file | ||
| 909 | (ada-parse-prj-file filename))) | ||
| 910 | |||
| 911 | 1012 | ||
| 912 | ;; ----- Identlist manipulation ------------------------------------------- | 1013 | ;; ----- Identlist manipulation ------------------------------------------- |
| 913 | ;; An identlist is a vector that is used internally to reference an identifier | 1014 | ;; An identlist is a vector that is used internally to reference an identifier |
| @@ -985,24 +1086,29 @@ option." | |||
| 985 | (mouse-set-point last-input-event) | 1086 | (mouse-set-point last-input-event) |
| 986 | (ada-goto-declaration (point))) | 1087 | (ada-goto-declaration (point))) |
| 987 | 1088 | ||
| 988 | (defun ada-goto-declaration (pos) | 1089 | (defun ada-goto-declaration (pos &optional other-frame) |
| 989 | "Display the declaration of the identifier around POS. | 1090 | "Display the declaration of the identifier around POS. |
| 990 | The declaration is shown in another buffer if `ada-xref-other-buffer' is | 1091 | The declaration is shown in another buffer if `ada-xref-other-buffer' is |
| 991 | non-nil." | 1092 | non-nil. |
| 1093 | If OTHER-FRAME is non-nil, display the cross-reference in another frame." | ||
| 992 | (interactive "d") | 1094 | (interactive "d") |
| 993 | (ada-require-project-file) | 1095 | (ada-require-project-file) |
| 994 | (push-mark pos) | 1096 | (push-mark pos) |
| 995 | (ada-xref-push-pos (buffer-file-name) pos) | 1097 | (ada-xref-push-pos (buffer-file-name) pos) |
| 996 | (ada-find-in-ali (ada-read-identifier pos))) | ||
| 997 | 1098 | ||
| 998 | (defun ada-goto-declaration-other-frame (pos) | 1099 | ;; First try the standard algorithm by looking into the .ali file, but if |
| 1100 | ;; that file was too old or even did not exist, try to look in the whole | ||
| 1101 | ;; object path for a possible location. | ||
| 1102 | (let ((identlist (ada-read-identifier pos))) | ||
| 1103 | (condition-case nil | ||
| 1104 | (ada-find-in-ali identlist other-frame) | ||
| 1105 | (error (ada-find-in-src-path identlist other-frame))))) | ||
| 1106 | |||
| 1107 | (defun ada-goto-declaration-other-frame (pos &optional other-frame) | ||
| 999 | "Display the declaration of the identifier around POS. | 1108 | "Display the declaration of the identifier around POS. |
| 1000 | The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." | 1109 | The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." |
| 1001 | (interactive "d") | 1110 | (interactive "d") |
| 1002 | (ada-require-project-file) | 1111 | (ada-goto-declaration pos t)) |
| 1003 | (push-mark pos) | ||
| 1004 | (ada-xref-push-pos (buffer-file-name) pos) | ||
| 1005 | (ada-find-in-ali (ada-read-identifier pos) t)) | ||
| 1006 | 1112 | ||
| 1007 | (defun ada-remote (command) | 1113 | (defun ada-remote (command) |
| 1008 | "Return the remote version of COMMAND, or COMMAND if remote_machine is nil." | 1114 | "Return the remote version of COMMAND, or COMMAND if remote_machine is nil." |
| @@ -1014,18 +1120,11 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." | |||
| 1014 | machine | 1120 | machine |
| 1015 | command)))) | 1121 | command)))) |
| 1016 | 1122 | ||
| 1017 | (defun ada-get-absolute-dir (dir root-dir) | ||
| 1018 | "Returns the absolute directory corresponding to DIR. | ||
| 1019 | If DIR is a relative directory, the value of ROOT-DIR is added in front." | ||
| 1020 | (if (= (string-to-char dir) ?/) | ||
| 1021 | dir | ||
| 1022 | (concat root-dir dir))) | ||
| 1023 | |||
| 1024 | (defun ada-get-absolute-dir-list (dir-list root-dir) | 1123 | (defun ada-get-absolute-dir-list (dir-list root-dir) |
| 1025 | "Returns the list of absolute directories found in dir-list. | 1124 | "Returns the list of absolute directories found in dir-list. |
| 1026 | If a directory is a relative directory, the value of ROOT-DIR is added in | 1125 | If a directory is a relative directory, the value of ROOT-DIR is added in |
| 1027 | front." | 1126 | front." |
| 1028 | (mapcar (lambda (x) (ada-get-absolute-dir x root-dir)) dir-list)) | 1127 | (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) |
| 1029 | 1128 | ||
| 1030 | (defun ada-set-environment () | 1129 | (defun ada-set-environment () |
| 1031 | "Return the new value for process-environment. | 1130 | "Return the new value for process-environment. |
| @@ -1035,21 +1134,21 @@ project file." | |||
| 1035 | (objects (getenv "ADA_OBJECTS_PATH")) | 1134 | (objects (getenv "ADA_OBJECTS_PATH")) |
| 1036 | (build-dir (ada-xref-get-project-field 'build_dir))) | 1135 | (build-dir (ada-xref-get-project-field 'build_dir))) |
| 1037 | (if include | 1136 | (if include |
| 1038 | (set 'include (concat include path-separator))) | 1137 | (set 'include (concat path-separator include))) |
| 1039 | (if objects | 1138 | (if objects |
| 1040 | (set 'objects (concat objects path-separator))) | 1139 | (set 'objects (concat path-separator objects))) |
| 1041 | (cons | 1140 | (cons |
| 1042 | (concat "ADA_INCLUDE_PATH=" | 1141 | (concat "ADA_INCLUDE_PATH=" |
| 1043 | include | 1142 | (mapconcat (lambda(x) (expand-file-name x build-dir)) |
| 1044 | (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir)) | ||
| 1045 | (ada-xref-get-project-field 'src_dir) | 1143 | (ada-xref-get-project-field 'src_dir) |
| 1046 | path-separator)) | 1144 | path-separator) |
| 1145 | include) | ||
| 1047 | (cons | 1146 | (cons |
| 1048 | (concat "ADA_OBJECTS_PATH=" | 1147 | (concat "ADA_OBJECTS_PATH=" |
| 1049 | objects | 1148 | (mapconcat (lambda(x) (expand-file-name x build-dir)) |
| 1050 | (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir)) | ||
| 1051 | (ada-xref-get-project-field 'obj_dir) | 1149 | (ada-xref-get-project-field 'obj_dir) |
| 1052 | path-separator)) | 1150 | path-separator) |
| 1151 | objects) | ||
| 1053 | process-environment)))) | 1152 | process-environment)))) |
| 1054 | 1153 | ||
| 1055 | (defun ada-compile-application (&optional arg) | 1154 | (defun ada-compile-application (&optional arg) |
| @@ -1061,19 +1160,26 @@ If ARG is not nil, ask for user confirmation." | |||
| 1061 | (process-environment (ada-set-environment)) | 1160 | (process-environment (ada-set-environment)) |
| 1062 | (compilation-scroll-output t)) | 1161 | (compilation-scroll-output t)) |
| 1063 | 1162 | ||
| 1064 | (set 'compilation-search-path | 1163 | (setq compilation-search-path (ada-xref-get-src-dir-field)) |
| 1065 | (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) | ||
| 1066 | (ada-xref-get-project-field 'build_dir))) | ||
| 1067 | 1164 | ||
| 1068 | ;; If no project file was found, ask the user | 1165 | ;; If no project file was found, ask the user |
| 1069 | (unless cmd | 1166 | (unless cmd |
| 1070 | (setq cmd "" arg t)) | 1167 | (setq cmd '("") arg t)) |
| 1071 | 1168 | ||
| 1072 | (compile (ada-remote | 1169 | ;; Make a single command from the list of commands, including the |
| 1073 | (if (or ada-xref-confirm-compile arg) | 1170 | ;; commands to run it on a remote machine. |
| 1074 | (read-from-minibuffer "enter command to compile: " cmd) | 1171 | (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) |
| 1075 | cmd))) | 1172 | |
| 1076 | )) | 1173 | (if (or ada-xref-confirm-compile arg) |
| 1174 | (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) | ||
| 1175 | |||
| 1176 | ;; Insert newlines so as to separate the name of the commands to run | ||
| 1177 | ;; and the output of the commands. this doesn't work with cmdproxy.exe, | ||
| 1178 | ;; which gets confused by newline characters. | ||
| 1179 | (if (not (string-match "cmdproxy.exe" shell-file-name)) | ||
| 1180 | (setq cmd (concat cmd "\n\n"))) | ||
| 1181 | |||
| 1182 | (compile (ada-quote-cmd cmd)))) | ||
| 1077 | 1183 | ||
| 1078 | (defun ada-compile-current (&optional arg prj-field) | 1184 | (defun ada-compile-current (&optional arg prj-field) |
| 1079 | "Recompile the current file. | 1185 | "Recompile the current file. |
| @@ -1087,19 +1193,26 @@ command, and should be either comp_cmd (default) or check_cmd." | |||
| 1087 | (process-environment (ada-set-environment)) | 1193 | (process-environment (ada-set-environment)) |
| 1088 | (compilation-scroll-output t)) | 1194 | (compilation-scroll-output t)) |
| 1089 | 1195 | ||
| 1090 | (set 'compilation-search-path | 1196 | (setq compilation-search-path (ada-xref-get-src-dir-field)) |
| 1091 | (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) | ||
| 1092 | (ada-xref-get-project-field 'build_dir))) | ||
| 1093 | 1197 | ||
| 1198 | (unless cmd | ||
| 1199 | (setq cmd '("") arg t)) | ||
| 1200 | |||
| 1201 | ;; Make a single command from the list of commands, including the | ||
| 1202 | ;; commands to run it on a remote machine. | ||
| 1203 | (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) | ||
| 1204 | |||
| 1094 | ;; If no project file was found, ask the user | 1205 | ;; If no project file was found, ask the user |
| 1095 | (if cmd | 1206 | (if (or ada-xref-confirm-compile arg) |
| 1096 | (set 'cmd (concat cmd " " (ada-convert-file-name (buffer-file-name)))) | 1207 | (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) |
| 1097 | (setq cmd "" arg t)) | 1208 | |
| 1209 | ;; Insert newlines so as to separate the name of the commands to run | ||
| 1210 | ;; and the output of the commands. this doesn't work with cmdproxy.exe, | ||
| 1211 | ;; which gets confused by newline characters. | ||
| 1212 | (if (not (string-match "cmdproxy.exe" shell-file-name)) | ||
| 1213 | (setq cmd (concat cmd "\n\n"))) | ||
| 1098 | 1214 | ||
| 1099 | (compile (ada-remote | 1215 | (compile (ada-quote-cmd cmd)))) |
| 1100 | (if (or ada-xref-confirm-compile arg) | ||
| 1101 | (read-from-minibuffer "enter command to compile: " cmd) | ||
| 1102 | cmd))))) | ||
| 1103 | 1216 | ||
| 1104 | (defun ada-check-current (&optional arg) | 1217 | (defun ada-check-current (&optional arg) |
| 1105 | "Recompile the current file. | 1218 | "Recompile the current file. |
| @@ -1120,24 +1233,32 @@ if ARG is not-nil, asks for user confirmation." | |||
| 1120 | (let ((command (ada-xref-get-project-field 'run_cmd))) | 1233 | (let ((command (ada-xref-get-project-field 'run_cmd))) |
| 1121 | 1234 | ||
| 1122 | ;; Guess the command if it wasn't specified | 1235 | ;; Guess the command if it wasn't specified |
| 1123 | (if (or (not command) (string= command "")) | 1236 | (if (not command) |
| 1124 | (set 'command (file-name-sans-extension (buffer-name)))) | 1237 | (set 'command (list (file-name-sans-extension (buffer-name))))) |
| 1125 | 1238 | ||
| 1239 | ;; Modify the command to run remotely | ||
| 1240 | (setq command (ada-remote (mapconcat 'identity command | ||
| 1241 | ada-command-separator))) | ||
| 1242 | |||
| 1126 | ;; Ask for the arguments to the command if required | 1243 | ;; Ask for the arguments to the command if required |
| 1127 | (if (or ada-xref-confirm-compile arg) | 1244 | (if (or ada-xref-confirm-compile arg) |
| 1128 | (set 'command (read-from-minibuffer "Enter command to execute: " command))) | 1245 | (setq command (read-from-minibuffer "Enter command to execute: " |
| 1129 | 1246 | command))) | |
| 1130 | ;; Modify the command to run remotely | ||
| 1131 | (setq command (ada-remote command)) | ||
| 1132 | 1247 | ||
| 1133 | ;; Run the command | 1248 | ;; Run the command |
| 1134 | (save-excursion | 1249 | (save-excursion |
| 1135 | (set-buffer (get-buffer-create "*run*")) | 1250 | (set-buffer (get-buffer-create "*run*")) |
| 1136 | (set 'buffer-read-only nil) | 1251 | (set 'buffer-read-only nil) |
| 1252 | |||
| 1137 | (erase-buffer) | 1253 | (erase-buffer) |
| 1138 | (goto-char (point-min)) | 1254 | (start-process "run" (current-buffer) shell-file-name |
| 1139 | (insert "\nRunning " command "\n\n") | 1255 | "-c" command) |
| 1140 | (start-process "run" (current-buffer) shell-file-name "-c" command) | 1256 | (comint-mode) |
| 1257 | ;; Set these two variables to their default values, since otherwise | ||
| 1258 | ;; the output buffer is scrolled so that only the last output line | ||
| 1259 | ;; is visible at the top of the buffer. | ||
| 1260 | (set (make-local-variable 'scroll-step) 0) | ||
| 1261 | (set (make-local-variable 'scroll-conservatively) 0) | ||
| 1141 | ) | 1262 | ) |
| 1142 | (display-buffer "*run*") | 1263 | (display-buffer "*run*") |
| 1143 | 1264 | ||
| @@ -1146,53 +1267,107 @@ if ARG is not-nil, asks for user confirmation." | |||
| 1146 | (switch-to-buffer "*run*") | 1267 | (switch-to-buffer "*run*") |
| 1147 | )) | 1268 | )) |
| 1148 | 1269 | ||
| 1149 | 1270 | (defun ada-gdb-application (&optional arg executable-name) | |
| 1150 | (defun ada-gdb-application (&optional arg) | ||
| 1151 | "Start the debugger on the application. | 1271 | "Start the debugger on the application. |
| 1272 | EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the | ||
| 1273 | project file. | ||
| 1152 | If ARG is non-nil, ask the user to confirm the command." | 1274 | If ARG is non-nil, ask the user to confirm the command." |
| 1153 | (interactive "P") | 1275 | (interactive "P") |
| 1154 | (let ((buffer (current-buffer)) | 1276 | (let ((buffer (current-buffer)) |
| 1155 | gdb-buffer | 1277 | cmd pre-cmd post-cmd) |
| 1156 | cmd) | ||
| 1157 | (ada-require-project-file) | 1278 | (ada-require-project-file) |
| 1158 | (set 'cmd (ada-xref-get-project-field 'debug_cmd)) | 1279 | (setq cmd (if executable-name |
| 1159 | (let ((machine (ada-xref-get-project-field 'remote_machine))) | 1280 | (concat ada-prj-default-debugger " " executable-name) |
| 1160 | (if (and machine (not (string= machine ""))) | 1281 | (ada-xref-get-project-field 'debug_cmd)) |
| 1161 | (error "This feature is not supported yet for remote environments"))) | 1282 | pre-cmd (ada-xref-get-project-field 'debug_pre_cmd) |
| 1283 | post-cmd (ada-xref-get-project-field 'debug_post_cmd)) | ||
| 1162 | 1284 | ||
| 1163 | ;; If the command was not given in the project file, start a bare gdb | 1285 | ;; If the command was not given in the project file, start a bare gdb |
| 1164 | (if (not cmd) | 1286 | (if (not cmd) |
| 1165 | (set 'cmd (concat ada-prj-default-debugger | 1287 | (set 'cmd (concat ada-prj-default-debugger |
| 1166 | " " | 1288 | " " |
| 1167 | (file-name-sans-extension (buffer-file-name))))) | 1289 | (or executable-name |
| 1290 | (file-name-sans-extension (buffer-file-name)))))) | ||
| 1291 | |||
| 1292 | ;; For gvd, add an extra switch so that the Emacs window is completly | ||
| 1293 | ;; swallowed inside the Gvd one | ||
| 1294 | (if (and ada-tight-gvd-integration | ||
| 1295 | (string-match "^[^ \t]*gvd" cmd)) | ||
| 1296 | ;; Start a new frame, so that when gvd exists we do not kill Emacs | ||
| 1297 | ;; We make sure that gvd swallows the new frame, not the one the | ||
| 1298 | ;; user has been using until now | ||
| 1299 | ;; The frame is made invisible initially, so that GtkPlug gets a | ||
| 1300 | ;; chance to fully manage it. Then it works fine with Enlightenment | ||
| 1301 | ;; as well | ||
| 1302 | (let ((frame (make-frame '((visibility . nil))))) | ||
| 1303 | (set 'cmd (concat | ||
| 1304 | cmd " --editor-window=" | ||
| 1305 | (cdr (assoc 'outer-window-id (frame-parameters frame))))) | ||
| 1306 | (select-frame frame))) | ||
| 1307 | |||
| 1308 | ;; Add a -fullname switch | ||
| 1309 | ;; Use the remote machine | ||
| 1310 | (set 'cmd (ada-remote (concat cmd " -fullname "))) | ||
| 1311 | |||
| 1312 | ;; Ask for confirmation if required | ||
| 1168 | (if (or arg ada-xref-confirm-compile) | 1313 | (if (or arg ada-xref-confirm-compile) |
| 1169 | (set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) | 1314 | (set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) |
| 1170 | 1315 | ||
| 1171 | ;; Set the variable gud-last-last-frame so that glide-debug can find | 1316 | (let (comint-exec |
| 1172 | ;; the name of the Ada file, and thus of the project file if needed. | 1317 | in-post-mode |
| 1173 | (if ada-prj-prj-file | 1318 | gud-gdb-massage-args) |
| 1174 | (set 'gud-last-last-frame (cons ada-prj-prj-file 1))) | 1319 | |
| 1175 | 1320 | ;; Do not add -fullname, since we can have a 'rsh' command in front. | |
| 1176 | (if (and (string-match "jdb" (comint-arguments cmd 0 0)) | 1321 | (fset 'gud-gdb-massage-args (lambda (file args) args)) |
| 1177 | (boundp 'jdb)) | 1322 | |
| 1178 | (funcall (symbol-function 'jdb) cmd) | 1323 | (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) |
| 1179 | (gdb cmd)) | 1324 | (if (not (equal pre-cmd "")) |
| 1180 | 1325 | (setq pre-cmd (concat pre-cmd ada-command-separator))) | |
| 1181 | (set 'gdb-buffer (symbol-value 'gud-comint-buffer)) | 1326 | |
| 1182 | 1327 | (set 'post-cmd (mapconcat 'identity post-cmd "\n")) | |
| 1183 | ;; Switch back to the source buffer | 1328 | (if post-cmd |
| 1184 | ;; and Activate the debug part in the contextual menu | 1329 | (set 'post-cmd (concat post-cmd "\n"))) |
| 1185 | (switch-to-buffer buffer) | 1330 | |
| 1186 | 1331 | ;; Temporarily replaces the definition of `comint-exec' so that we | |
| 1187 | (if (functionp 'gud-make-debug-menu) | 1332 | ;; can execute commands before running gdb. |
| 1188 | (funcall (symbol-function 'gud-make-debug-menu))) | 1333 | (fset 'comint-exec |
| 1189 | 1334 | `(lambda (buffer name command startfile switches) | |
| 1190 | ;; Warning: on Emacs >= 20.3.8, same-window-regexps includes gud-*, | 1335 | (let (compilation-buffer-name-function) |
| 1191 | ;; so the following call to display buffer will select the | 1336 | (save-excursion |
| 1192 | ;; buffer instead of displaying it in another window | 1337 | (set 'compilation-buffer-name-function |
| 1193 | ;; This is why the second argument to display-buffer is 't' | 1338 | (lambda(x) (buffer-name buffer))) |
| 1194 | (display-buffer gdb-buffer t) | 1339 | (compile (ada-quote-cmd |
| 1195 | )) | 1340 | (concat ,pre-cmd |
| 1341 | command " " | ||
| 1342 | (mapconcat 'identity switches " ")))))) | ||
| 1343 | )) | ||
| 1344 | |||
| 1345 | ;; Tight integration should force the tty mode | ||
| 1346 | (if (and (string-match "gvd" (comint-arguments cmd 0 0)) | ||
| 1347 | ada-tight-gvd-integration | ||
| 1348 | (not (string-match "--tty" cmd))) | ||
| 1349 | (setq cmd (concat cmd "--tty"))) | ||
| 1350 | |||
| 1351 | (if (and (string-match "jdb" (comint-arguments cmd 0 0)) | ||
| 1352 | (boundp 'jdb)) | ||
| 1353 | (funcall (symbol-function 'jdb) cmd) | ||
| 1354 | (gdb cmd)) | ||
| 1355 | |||
| 1356 | ;; Send post-commands to the debugger | ||
| 1357 | (process-send-string (get-buffer-process (current-buffer)) post-cmd) | ||
| 1358 | |||
| 1359 | ;; Move to the end of the debugger buffer, so that it is automatically | ||
| 1360 | ;; scrolled from then on. | ||
| 1361 | (end-of-buffer) | ||
| 1362 | |||
| 1363 | ;; Display both the source window and the debugger window (the former | ||
| 1364 | ;; above the latter). No need to show the debugger window unless it | ||
| 1365 | ;; is going to have some relevant information. | ||
| 1366 | (if (or (not (string-match "gvd" (comint-arguments cmd 0 0))) | ||
| 1367 | (string-match "--tty" cmd)) | ||
| 1368 | (split-window-vertically)) | ||
| 1369 | (switch-to-buffer buffer) | ||
| 1370 | ))) | ||
| 1196 | 1371 | ||
| 1197 | 1372 | ||
| 1198 | (defun ada-reread-prj-file (&optional filename) | 1373 | (defun ada-reread-prj-file (&optional filename) |
| @@ -1205,35 +1380,53 @@ automatically modifies the setup for all the Ada buffer that use this file." | |||
| 1205 | (if filename | 1380 | (if filename |
| 1206 | (ada-parse-prj-file filename) | 1381 | (ada-parse-prj-file filename) |
| 1207 | (ada-parse-prj-file (ada-prj-find-prj-file))) | 1382 | (ada-parse-prj-file (ada-prj-find-prj-file))) |
| 1208 | ) | ||
| 1209 | 1383 | ||
| 1384 | ;; Reread the location of the standard runtime library | ||
| 1385 | (ada-initialize-runtime-library | ||
| 1386 | (or (ada-xref-get-project-field 'cross-prefix) "")) | ||
| 1387 | ) | ||
| 1210 | 1388 | ||
| 1211 | ;; ------ Private routines | 1389 | ;; ------ Private routines |
| 1212 | 1390 | ||
| 1213 | (defun ada-xref-current (file &optional ali-file-name) | 1391 | (defun ada-xref-current (file &optional ali-file-name) |
| 1214 | "Update the cross-references for FILE. | 1392 | "Update the cross-references for FILE. |
| 1215 | This in fact recompiles FILE to create ALI-FILE-NAME." | 1393 | This in fact recompiles FILE to create ALI-FILE-NAME. |
| 1394 | This function returns the name of the file that was recompiled to generate | ||
| 1395 | the cross-reference information. Note that the ali file can then be deduced by | ||
| 1396 | replacing the file extension with .ali" | ||
| 1216 | ;; kill old buffer | 1397 | ;; kill old buffer |
| 1217 | (if (and ali-file-name | 1398 | (if (and ali-file-name |
| 1218 | (get-file-buffer ali-file-name)) | 1399 | (get-file-buffer ali-file-name)) |
| 1219 | (kill-buffer (get-file-buffer ali-file-name))) | 1400 | (kill-buffer (get-file-buffer ali-file-name))) |
| 1220 | ;; read the project file | 1401 | |
| 1221 | (ada-require-project-file) | 1402 | (let* ((name (ada-convert-file-name file)) |
| 1222 | (let* ((cmd (ada-xref-get-project-field 'comp_cmd)) | 1403 | (body-name (or (ada-get-body-name name) name))) |
| 1223 | (process-environment (ada-set-environment)) | ||
| 1224 | (compilation-scroll-output t) | ||
| 1225 | (name (ada-convert-file-name (buffer-file-name))) | ||
| 1226 | (body-name (ada-get-body-name name))) | ||
| 1227 | |||
| 1228 | ;; Always recompile the body when we can | ||
| 1229 | (set 'body-name (or body-name name)) | ||
| 1230 | 1404 | ||
| 1231 | ;; prompt for command to execute | 1405 | ;; Always recompile the body when we can. We thus temporarily switch to a |
| 1232 | (set 'cmd (concat cmd " " body-name)) | 1406 | ;; buffer than contains the body of the unit |
| 1233 | (compile (ada-remote | 1407 | (save-excursion |
| 1234 | (if ada-xref-confirm-compile | 1408 | (let ((body-visible (find-buffer-visiting body-name)) |
| 1235 | (read-from-minibuffer "enter command to compile: " cmd) | 1409 | process) |
| 1236 | cmd))))) | 1410 | (if body-visible |
| 1411 | (set-buffer body-visible) | ||
| 1412 | (find-file body-name)) | ||
| 1413 | |||
| 1414 | ;; Execute the compilation. Note that we must wait for the end of the | ||
| 1415 | ;; process, or the ALI file would still not be available. | ||
| 1416 | ;; Unfortunately, the underlying `compile' command that we use is | ||
| 1417 | ;; asynchronous. | ||
| 1418 | (ada-compile-current) | ||
| 1419 | (setq process (get-buffer-process "*compilation*")) | ||
| 1420 | |||
| 1421 | (while (and process | ||
| 1422 | (not (equal (process-status process) 'exit))) | ||
| 1423 | (sit-for 1)) | ||
| 1424 | |||
| 1425 | ;; remove the buffer for the body if it wasn't there before | ||
| 1426 | (unless body-visible | ||
| 1427 | (kill-buffer (find-buffer-visiting body-name))) | ||
| 1428 | )) | ||
| 1429 | body-name)) | ||
| 1237 | 1430 | ||
| 1238 | (defun ada-find-file-in-dir (file dir-list) | 1431 | (defun ada-find-file-in-dir (file dir-list) |
| 1239 | "Search for FILE in DIR-LIST." | 1432 | "Search for FILE in DIR-LIST." |
| @@ -1251,36 +1444,13 @@ This in fact recompiles FILE to create ALI-FILE-NAME." | |||
| 1251 | "Find an .ali file in obj_dir. The current buffer must be the Ada file. | 1444 | "Find an .ali file in obj_dir. The current buffer must be the Ada file. |
| 1252 | Adds build_dir in front of the search path to conform to gnatmake's behavior, | 1445 | Adds build_dir in front of the search path to conform to gnatmake's behavior, |
| 1253 | and the standard runtime location at the end." | 1446 | and the standard runtime location at the end." |
| 1254 | (ada-find-file-in-dir file | 1447 | (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) |
| 1255 | (append | ||
| 1256 | |||
| 1257 | ;; Add ${build_dir} in front of the path | ||
| 1258 | (list (ada-xref-get-project-field 'build_dir)) | ||
| 1259 | |||
| 1260 | (ada-get-absolute-dir-list | ||
| 1261 | (ada-xref-get-project-field 'obj_dir) | ||
| 1262 | (ada-xref-get-project-field 'build_dir)) | ||
| 1263 | |||
| 1264 | ;; Add the standard runtime at the end | ||
| 1265 | ada-xref-runtime-library-ali-path))) | ||
| 1266 | 1448 | ||
| 1267 | (defun ada-find-src-file-in-dir (file) | 1449 | (defun ada-find-src-file-in-dir (file) |
| 1268 | "Find a source file in src_dir. The current buffer must be the Ada file. | 1450 | "Find a source file in src_dir. The current buffer must be the Ada file. |
| 1269 | Adds src_dir in front of the search path to conform to gnatmake's behavior, | 1451 | Adds src_dir in front of the search path to conform to gnatmake's behavior, |
| 1270 | and the standard runtime location at the end." | 1452 | and the standard runtime location at the end." |
| 1271 | (ada-find-file-in-dir file | 1453 | (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) |
| 1272 | (append | ||
| 1273 | |||
| 1274 | ;; Add ${build_dir} in front of the path | ||
| 1275 | (list (ada-xref-get-project-field 'build_dir)) | ||
| 1276 | |||
| 1277 | (ada-get-absolute-dir-list | ||
| 1278 | (ada-xref-get-project-field 'src_dir) | ||
| 1279 | (ada-xref-get-project-field 'build_dir)) | ||
| 1280 | |||
| 1281 | ;; Add the standard runtime at the end | ||
| 1282 | ada-xref-runtime-library-specs-path))) | ||
| 1283 | |||
| 1284 | 1454 | ||
| 1285 | (defun ada-get-ali-file-name (file) | 1455 | (defun ada-get-ali-file-name (file) |
| 1286 | "Create the ali file name for the ada-file FILE. | 1456 | "Create the ali file name for the ada-file FILE. |
| @@ -1298,68 +1468,98 @@ the project file." | |||
| 1298 | ;; 3- If the file is not found or step 2 failed: | 1468 | ;; 3- If the file is not found or step 2 failed: |
| 1299 | ;; find the name of the "other file", ie the body, and look | 1469 | ;; find the name of the "other file", ie the body, and look |
| 1300 | ;; for its associated .ali file by subtituing the extension | 1470 | ;; for its associated .ali file by subtituing the extension |
| 1471 | ;; | ||
| 1472 | ;; We must also handle the case of separate packages and subprograms: | ||
| 1473 | ;; 4- If no ali file was found, we try to modify the file name by removing | ||
| 1474 | ;; everything after the last '-' or '.' character, so as to get the | ||
| 1475 | ;; ali file for the parent unit. If we found an ali file, we check that | ||
| 1476 | ;; it indeed contains the definition for the separate entity by checking | ||
| 1477 | ;; the 'D' lines. This is done repeatedly, in case the direct parent is | ||
| 1478 | ;; also a separate. | ||
| 1301 | 1479 | ||
| 1302 | (save-excursion | 1480 | (save-excursion |
| 1303 | (set-buffer (get-file-buffer file)) | 1481 | (set-buffer (get-file-buffer file)) |
| 1304 | (let ((short-ali-file-name | 1482 | (let ((short-ali-file-name |
| 1305 | (concat (file-name-sans-extension (file-name-nondirectory file)) | 1483 | (concat (file-name-sans-extension (file-name-nondirectory file)) |
| 1306 | ".ali")) | 1484 | ".ali")) |
| 1307 | ali-file-name) | 1485 | ali-file-name |
| 1308 | ;; First step | 1486 | is-spec) |
| 1309 | ;; we take the first possible completion | 1487 | |
| 1310 | (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name)) | 1488 | ;; If we have a non-standard file name, and this is a spec, we first |
| 1311 | 1489 | ;; look for the .ali file of the body, since this is the one that | |
| 1312 | ;; If we have found the .ali file, but the source file was a spec | 1490 | ;; contains the most complete information. If not found, we will do what |
| 1313 | ;; with a non-standard name, search the .ali file for the body if any, | 1491 | ;; we can with the .ali file for the spec... |
| 1314 | ;; since the xref information is more complete in that one | 1492 | |
| 1315 | (unless ali-file-name | 1493 | (if (not (string= (file-name-extension file) "ads")) |
| 1316 | (if (not (string= (file-name-extension file) "ads")) | 1494 | (let ((specs ada-spec-suffixes)) |
| 1317 | (let ((is-spec nil) | 1495 | (while specs |
| 1318 | (specs ada-spec-suffixes) | 1496 | (if (string-match (concat (regexp-quote (car specs)) "$") |
| 1319 | body-ali) | 1497 | file) |
| 1320 | (while specs | 1498 | (set 'is-spec t)) |
| 1321 | (if (string-match (concat (regexp-quote (car specs)) "$") | 1499 | (set 'specs (cdr specs))))) |
| 1322 | file) | 1500 | |
| 1323 | (set 'is-spec t)) | 1501 | (if is-spec |
| 1324 | (set 'specs (cdr specs))) | 1502 | (set 'ali-file-name |
| 1325 | 1503 | (ada-find-ali-file-in-dir | |
| 1326 | (if is-spec | 1504 | (concat (file-name-sans-extension |
| 1327 | (set 'body-ali | 1505 | (file-name-nondirectory |
| 1328 | (ada-find-ali-file-in-dir | 1506 | (ada-other-file-name))) |
| 1329 | (concat (file-name-sans-extension | 1507 | ".ali")))) |
| 1330 | (file-name-nondirectory | 1508 | |
| 1331 | (ada-other-file-name))) | 1509 | |
| 1332 | ".ali")))) | 1510 | (setq ali-file-name |
| 1333 | (if body-ali | 1511 | (or ali-file-name |
| 1334 | (set 'ali-file-name body-ali)))) | 1512 | |
| 1335 | 1513 | ;; Else we take the .ali file associated with the unit | |
| 1336 | ;; else we did not find the .ali file | 1514 | (ada-find-ali-file-in-dir short-ali-file-name) |
| 1337 | ;; Second chance: in case the files do not have standard names (such | 1515 | |
| 1338 | ;; as for instance file_s.ada and file_b.ada), try to go to the | 1516 | |
| 1339 | ;; other file and look for its ali file | 1517 | ;; else we did not find the .ali file Second chance: in case |
| 1340 | (setq short-ali-file-name | 1518 | ;; the files do not have standard names (such as for instance |
| 1341 | (concat (file-name-sans-extension | 1519 | ;; file_s.ada and file_b.ada), try to go to the other file |
| 1342 | (file-name-nondirectory (ada-other-file-name))) | 1520 | ;; and look for its ali file |
| 1343 | ".ali")) | 1521 | (ada-find-ali-file-in-dir |
| 1344 | (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name)) | 1522 | (concat (file-name-sans-extension |
| 1345 | 1523 | (file-name-nondirectory (ada-other-file-name))) | |
| 1346 | ;; If still not found, try to recompile the file | 1524 | ".ali")) |
| 1347 | (if (not ali-file-name) | 1525 | |
| 1348 | (progn | 1526 | |
| 1349 | ;; recompile only if the user asked for this | 1527 | ;; If we still don't have an ali file, try to get the one |
| 1350 | (if ada-xref-create-ali | 1528 | ;; from the parent unit, in case we have a separate entity. |
| 1351 | (ada-xref-current file ali-file-name)) | 1529 | (let ((parent-name (file-name-sans-extension |
| 1352 | (error "Ali file not found. Recompile your file"))) | 1530 | (file-name-nondirectory file)))) |
| 1353 | ) | 1531 | |
| 1532 | (while (and (not ali-file-name) | ||
| 1533 | (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) | ||
| 1534 | |||
| 1535 | (set 'parent-name (match-string 1 parent-name)) | ||
| 1536 | (set 'ali-file-name (ada-find-ali-file-in-dir | ||
| 1537 | (concat parent-name ".ali"))) | ||
| 1538 | ) | ||
| 1539 | ali-file-name))) | ||
| 1540 | |||
| 1541 | ;; If still not found, try to recompile the file | ||
| 1542 | (if (not ali-file-name) | ||
| 1543 | ;; recompile only if the user asked for this. and search the ali | ||
| 1544 | ;; filename again. We avoid a possible infinite recursion by | ||
| 1545 | ;; temporarily disabling the automatic compilation. | ||
| 1546 | |||
| 1547 | (if ada-xref-create-ali | ||
| 1548 | (setq ali-file-name | ||
| 1549 | (concat (file-name-sans-extension (ada-xref-current file)) | ||
| 1550 | ".ali")) | ||
| 1354 | 1551 | ||
| 1355 | ;; same if the .ali file is too old and we must recompile it | 1552 | (error "Ali file not found. Recompile your file")) |
| 1356 | (if (and (file-newer-than-file-p file ali-file-name) | 1553 | |
| 1357 | ada-xref-create-ali) | 1554 | |
| 1358 | (ada-xref-current file ali-file-name)) | 1555 | ;; same if the .ali file is too old and we must recompile it |
| 1556 | (if (and (file-newer-than-file-p file ali-file-name) | ||
| 1557 | ada-xref-create-ali) | ||
| 1558 | (ada-xref-current file ali-file-name))) | ||
| 1359 | 1559 | ||
| 1360 | ;; else returns the correct absolute file name | 1560 | ;; Always return the correct absolute file name |
| 1361 | (expand-file-name ali-file-name)) | 1561 | (expand-file-name ali-file-name)) |
| 1362 | )) | 1562 | )) |
| 1363 | 1563 | ||
| 1364 | (defun ada-get-ada-file-name (file original-file) | 1564 | (defun ada-get-ada-file-name (file original-file) |
| 1365 | "Create the complete file name (+directory) for FILE. | 1565 | "Create the complete file name (+directory) for FILE. |
| @@ -1398,14 +1598,9 @@ file for possible paths." | |||
| 1398 | (count-lines begin (point)))) | 1598 | (count-lines begin (point)))) |
| 1399 | 1599 | ||
| 1400 | (defun ada-read-identifier (pos) | 1600 | (defun ada-read-identifier (pos) |
| 1401 | "Returns the identlist around POS and switch to the .ali buffer." | 1601 | "Returns the identlist around POS and switch to the .ali buffer. |
| 1402 | 1602 | The returned list represents the entity, and can be manipulated through the | |
| 1403 | ;; If there's a compilation in progress, it's probably because the | 1603 | macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." |
| 1404 | ;; .ali file didn't exist. So we should wait... | ||
| 1405 | (if compilation-in-progress | ||
| 1406 | (progn | ||
| 1407 | (message "Compilation in progress. Try again when it is finished") | ||
| 1408 | (set 'quit-flag t))) | ||
| 1409 | 1604 | ||
| 1410 | ;; If at end of buffer (e.g the buffer is empty), error | 1605 | ;; If at end of buffer (e.g the buffer is empty), error |
| 1411 | (if (>= (point) (point-max)) | 1606 | (if (>= (point) (point-max)) |
| @@ -1510,11 +1705,13 @@ from the ali file (definition file and places where it is referenced)." | |||
| 1510 | ;; if we did not find it, it may be because the first reference | 1705 | ;; if we did not find it, it may be because the first reference |
| 1511 | ;; is not required to have a 'unit_number|' item included. | 1706 | ;; is not required to have a 'unit_number|' item included. |
| 1512 | ;; Or maybe we are already on the declaration... | 1707 | ;; Or maybe we are already on the declaration... |
| 1513 | (unless (re-search-forward (concat "^\\([a-zA-Z0-9_.\"]+[ *]\\)*" | 1708 | (unless (re-search-forward |
| 1514 | (ada-line-of identlist) | 1709 | (concat |
| 1515 | "[^0-9]" | 1710 | "^\\(\\([a-zA-Z0-9_.]+\\|\"[<>=+*-/a-z]\"\\)[ *]\\)*" |
| 1516 | (ada-column-of identlist)) | 1711 | (ada-line-of identlist) |
| 1517 | nil t) | 1712 | "[^0-9]" |
| 1713 | (ada-column-of identlist)) | ||
| 1714 | nil t) | ||
| 1518 | 1715 | ||
| 1519 | ;; If still not found, then either the declaration is unknown | 1716 | ;; If still not found, then either the declaration is unknown |
| 1520 | ;; or the source file has been modified since the ali file was | 1717 | ;; or the source file has been modified since the ali file was |
| @@ -1566,10 +1763,19 @@ from the ali file (definition file and places where it is referenced)." | |||
| 1566 | ) | 1763 | ) |
| 1567 | 1764 | ||
| 1568 | (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) | 1765 | (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) |
| 1569 | (ada-set-declare-file | 1766 | |
| 1570 | identlist | 1767 | ;; If we can find the file |
| 1571 | (ada-get-ada-file-name (match-string 1) | 1768 | (condition-case err |
| 1572 | (ada-file-of identlist)))) | 1769 | (ada-set-declare-file |
| 1770 | identlist | ||
| 1771 | (ada-get-ada-file-name (match-string 1) | ||
| 1772 | (ada-file-of identlist))) | ||
| 1773 | |||
| 1774 | ;; Else clean up the ali file | ||
| 1775 | (error | ||
| 1776 | (kill-buffer ali-buffer) | ||
| 1777 | (error (error-message-string err))) | ||
| 1778 | )) | ||
| 1573 | 1779 | ||
| 1574 | (ada-set-references identlist current-line) | 1780 | (ada-set-references identlist current-line) |
| 1575 | )) | 1781 | )) |
| @@ -1630,34 +1836,37 @@ This function is disabled for operators, and only works for identifiers." | |||
| 1630 | 1836 | ||
| 1631 | ;; more than one => display choice list | 1837 | ;; more than one => display choice list |
| 1632 | (t | 1838 | (t |
| 1633 | (with-output-to-temp-buffer "*choice list*" | 1839 | (save-window-excursion |
| 1634 | 1840 | (with-output-to-temp-buffer "*choice list*" | |
| 1635 | (princ "Identifier is overloaded and Xref information is not up to date.\n") | 1841 | |
| 1636 | (princ "Possible declarations are:\n\n") | 1842 | (princ "Identifier is overloaded and Xref information is not up to date.\n") |
| 1637 | (princ " no. in file at line col\n") | 1843 | (princ "Possible declarations are:\n\n") |
| 1638 | (princ " --- --------------------- ---- ----\n") | 1844 | (princ " no. in file at line col\n") |
| 1639 | (let ((counter 1)) | 1845 | (princ " --- --------------------- ---- ----\n") |
| 1640 | (while (<= counter len) | 1846 | (let ((counter 0)) |
| 1641 | (princ (format " %2d) %-21s %4s %4s\n" | 1847 | (while (< counter len) |
| 1642 | counter | 1848 | (princ (format " %2d) %-21s %4s %4s\n" |
| 1849 | (1+ counter) | ||
| 1643 | (ada-get-ada-file-name | 1850 | (ada-get-ada-file-name |
| 1644 | (nth 1 (nth (1- counter) declist)) | 1851 | (nth 1 (nth counter declist)) |
| 1645 | (ada-file-of identlist)) | 1852 | (ada-file-of identlist)) |
| 1646 | (nth 2 (nth (1- counter) declist)) | 1853 | (nth 2 (nth counter declist)) |
| 1647 | (nth 3 (nth (1- counter) declist)) | 1854 | (nth 3 (nth counter declist)) |
| 1648 | )) | 1855 | )) |
| 1649 | (setq counter (1+ counter)) | 1856 | (setq counter (1+ counter)) |
| 1650 | ) ; end of while | 1857 | ) ; end of while |
| 1651 | ) ; end of let | 1858 | ) ; end of let |
| 1652 | ) ; end of with-output-to ... | 1859 | ) ; end of with-output-to ... |
| 1653 | (setq choice nil) | 1860 | (setq choice nil) |
| 1654 | (while (or | 1861 | (while (or |
| 1655 | (not choice) | 1862 | (not choice) |
| 1656 | (not (integerp choice)) | 1863 | (not (integerp choice)) |
| 1657 | (< choice 1) | 1864 | (< choice 1) |
| 1658 | (> choice len)) | 1865 | (> choice len)) |
| 1659 | (setq choice (string-to-int | 1866 | (setq choice |
| 1660 | (read-from-minibuffer "Enter No. of your choice: ")))) | 1867 | (string-to-int |
| 1868 | (read-from-minibuffer "Enter No. of your choice: ")))) | ||
| 1869 | ) | ||
| 1661 | (set-buffer ali-buffer) | 1870 | (set-buffer ali-buffer) |
| 1662 | (goto-line (car (nth (1- choice) declist))) | 1871 | (goto-line (car (nth (1- choice) declist))) |
| 1663 | )))))) | 1872 | )))))) |
| @@ -1670,60 +1879,203 @@ opens a new window to show the declaration." | |||
| 1670 | 1879 | ||
| 1671 | (ada-get-all-references identlist) | 1880 | (ada-get-all-references identlist) |
| 1672 | (let ((ali-line (ada-references-of identlist)) | 1881 | (let ((ali-line (ada-references-of identlist)) |
| 1882 | (locations nil) | ||
| 1883 | (start 0) | ||
| 1673 | file line col) | 1884 | file line col) |
| 1885 | |||
| 1886 | ;; Note: in some cases, an entity can have multiple references to the | ||
| 1887 | ;; bodies (this is for instance the case for a separate subprogram, that | ||
| 1888 | ;; has a reference both to the stub and to the real body). | ||
| 1889 | ;; In that case, we simply go to each one in turn. | ||
| 1890 | |||
| 1891 | ;; Get all the possible locations | ||
| 1892 | (string-match "^\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line) | ||
| 1893 | (set 'locations (list (list (match-string 1 ali-line) ;; line | ||
| 1894 | (match-string 2 ali-line) ;; column | ||
| 1895 | (ada-declare-file-of identlist)))) | ||
| 1896 | (while (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line start) | ||
| 1897 | (setq line (match-string 1 ali-line) | ||
| 1898 | col (match-string 2 ali-line) | ||
| 1899 | start (match-end 2)) | ||
| 1900 | |||
| 1901 | ;; it there was a file number in the same line | ||
| 1902 | (if (string-match (concat "\\([0-9]+\\)|\\([^|bc]+\\)?" | ||
| 1903 | (match-string 0 ali-line)) | ||
| 1904 | ali-line) | ||
| 1905 | (let ((file-number (match-string 1 ali-line))) | ||
| 1906 | (goto-char (point-min)) | ||
| 1907 | (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t | ||
| 1908 | (string-to-number file-number)) | ||
| 1909 | (set 'file (match-string 1)) | ||
| 1910 | ) | ||
| 1911 | ;; Else get the nearest file | ||
| 1912 | (set 'file (ada-declare-file-of identlist))) | ||
| 1913 | |||
| 1914 | (set 'locations (append locations (list (list line col file))))) | ||
| 1915 | |||
| 1916 | ;; Add the specs at the end again, so that from the last body we go to | ||
| 1917 | ;; the specs | ||
| 1918 | (set 'locations (append locations (list (car locations)))) | ||
| 1919 | |||
| 1920 | ;; Find the new location we want to go to. | ||
| 1921 | ;; If we are on none of the locations listed, we simply go to the specs. | ||
| 1922 | |||
| 1923 | (setq line (caar locations) | ||
| 1924 | col (nth 1 (car locations)) | ||
| 1925 | file (nth 2 (car locations))) | ||
| 1674 | 1926 | ||
| 1675 | ;; If we were on a declaration, go to the body | 1927 | (while locations |
| 1676 | (if (ada-on-declaration identlist) | 1928 | (if (and (string= (caar locations) (ada-line-of identlist)) |
| 1677 | (if (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line) | 1929 | (string= (nth 1 (car locations)) (ada-column-of identlist)) |
| 1678 | (progn | 1930 | (string= (file-name-nondirectory (nth 2 (car locations))) |
| 1679 | (setq line (match-string 1 ali-line) | 1931 | (file-name-nondirectory (ada-file-of identlist)))) |
| 1680 | col (match-string 2 ali-line)) | 1932 | (setq locations (cadr locations) |
| 1681 | ;; it there was a file number in the same line | 1933 | line (car locations) |
| 1682 | (if (string-match "\\([0-9]+\\)|\\([^|bc]+\\)?[bc]" ali-line) | 1934 | col (nth 1 locations) |
| 1683 | (let ((file-number (match-string 1 ali-line))) | 1935 | file (nth 2 locations) |
| 1684 | (goto-char (point-min)) | 1936 | locations nil) |
| 1685 | (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t | 1937 | (set 'locations (cdr locations)))) |
| 1686 | (string-to-number file-number)) | 1938 | |
| 1687 | (set 'file (match-string 1)) | 1939 | ;; Find the file in the source path |
| 1688 | ) | 1940 | (set 'file (ada-get-ada-file-name file (ada-file-of identlist))) |
| 1689 | ;; Else get the nearest file | 1941 | |
| 1690 | (set 'file (ada-declare-file-of identlist)) | 1942 | ;; Kill the .ali buffer |
| 1691 | ) | 1943 | (kill-buffer (current-buffer)) |
| 1692 | ) | ||
| 1693 | (error "No body found")) | ||
| 1694 | |||
| 1695 | ;; Else we were not on the declaration, find the place for it | ||
| 1696 | (string-match "\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line) | ||
| 1697 | (setq line (match-string 1 ali-line) | ||
| 1698 | col (match-string 2 ali-line) | ||
| 1699 | file (ada-declare-file-of identlist)) | ||
| 1700 | ) | ||
| 1701 | 1944 | ||
| 1702 | ;; Now go to the buffer | 1945 | ;; Now go to the buffer |
| 1703 | (ada-xref-change-buffer | 1946 | (ada-xref-change-buffer file |
| 1704 | (ada-get-ada-file-name file (ada-file-of identlist)) | 1947 | (string-to-number line) |
| 1705 | (string-to-number line) | 1948 | (1- (string-to-number col)) |
| 1706 | (1- (string-to-number col)) | 1949 | identlist |
| 1707 | identlist | 1950 | other-frame) |
| 1708 | other-frame) | ||
| 1709 | )) | 1951 | )) |
| 1710 | 1952 | ||
| 1953 | (defun ada-find-in-src-path (identlist &optional other-frame) | ||
| 1954 | "More general function for cross-references. | ||
| 1955 | This function should be used when the standard algorithm that parses the | ||
| 1956 | .ali file has failed, either because that file was too old or even did not | ||
| 1957 | exist. | ||
| 1958 | This function attempts to find the possible declarations for the identifier | ||
| 1959 | anywhere in the object path. | ||
| 1960 | This command requires the external `egrep' program to be available. | ||
| 1961 | |||
| 1962 | This works well when one is using an external librarie and wants | ||
| 1963 | to find the declaration and documentation of the subprograms one is | ||
| 1964 | is using." | ||
| 1965 | |||
| 1966 | (let (list | ||
| 1967 | (dirs (ada-xref-get-obj-dir-field)) | ||
| 1968 | (regexp (concat "[ *]" (ada-name-of identlist))) | ||
| 1969 | line column | ||
| 1970 | choice | ||
| 1971 | file) | ||
| 1972 | |||
| 1973 | (save-excursion | ||
| 1974 | |||
| 1975 | ;; Do the grep in all the directories. We do multiple shell | ||
| 1976 | ;; commands instead of one in case there is no .ali file in one | ||
| 1977 | ;; of the directory and the shell stops because of that. | ||
| 1978 | |||
| 1979 | (set-buffer (get-buffer-create "*grep*")) | ||
| 1980 | (while dirs | ||
| 1981 | (insert (shell-command-to-string | ||
| 1982 | (concat "egrep -i -h '^X|" regexp "( |$)' " | ||
| 1983 | (file-name-as-directory (car dirs)) "*.ali"))) | ||
| 1984 | (set 'dirs (cdr dirs))) | ||
| 1985 | |||
| 1986 | ;; Now parse the output | ||
| 1987 | (set 'case-fold-search t) | ||
| 1988 | (goto-char (point-min)) | ||
| 1989 | (while (re-search-forward regexp nil t) | ||
| 1990 | (save-excursion | ||
| 1991 | (beginning-of-line) | ||
| 1992 | (if (not (= (char-after) ?X)) | ||
| 1993 | (progn | ||
| 1994 | (looking-at "\\([0-9]+\\).\\([0-9]+\\)") | ||
| 1995 | (setq line (match-string 1) | ||
| 1996 | column (match-string 2)) | ||
| 1997 | (re-search-backward "^X [0-9]+ \\(.*\\)$") | ||
| 1998 | (set 'file (list (match-string 1) line column)) | ||
| 1999 | |||
| 2000 | ;; There could be duplicate choices, because of the structure | ||
| 2001 | ;; of the .ali files | ||
| 2002 | (unless (member file list) | ||
| 2003 | (set 'list (append list (list file)))))))) | ||
| 2004 | |||
| 2005 | ;; Current buffer is still "*grep*" | ||
| 2006 | (kill-buffer "*grep*") | ||
| 2007 | ) | ||
| 2008 | |||
| 2009 | ;; Now display the list of possible matches | ||
| 2010 | (cond | ||
| 2011 | |||
| 2012 | ;; No choice found => Error | ||
| 2013 | ((null list) | ||
| 2014 | (error "No cross-reference found, please recompile your file")) | ||
| 2015 | |||
| 2016 | ;; Only one choice => Do the cross-reference | ||
| 2017 | ((= (length list) 1) | ||
| 2018 | (set 'file (ada-find-src-file-in-dir (caar list))) | ||
| 2019 | (if file | ||
| 2020 | (ada-xref-change-buffer file | ||
| 2021 | (string-to-number (nth 1 (car list))) | ||
| 2022 | (string-to-number (nth 2 (car list))) | ||
| 2023 | identlist | ||
| 2024 | other-frame) | ||
| 2025 | (error (concat (caar list) " not found in src_dir"))) | ||
| 2026 | (message "This is only a (good) guess at the cross-reference.") | ||
| 2027 | ) | ||
| 2028 | |||
| 2029 | ;; Else, ask the user | ||
| 2030 | (t | ||
| 2031 | (save-window-excursion | ||
| 2032 | (with-output-to-temp-buffer "*choice list*" | ||
| 2033 | |||
| 2034 | (princ "Identifier is overloaded and Xref information is not up to date.\n") | ||
| 2035 | (princ "Possible declarations are:\n\n") | ||
| 2036 | (princ " no. in file at line col\n") | ||
| 2037 | (princ " --- --------------------- ---- ----\n") | ||
| 2038 | (let ((counter 0)) | ||
| 2039 | (while (< counter (length list)) | ||
| 2040 | (princ (format " %2d) %-21s %4s %4s\n" | ||
| 2041 | (1+ counter) | ||
| 2042 | (nth 0 (nth counter list)) | ||
| 2043 | (nth 1 (nth counter list)) | ||
| 2044 | (nth 2 (nth counter list)) | ||
| 2045 | )) | ||
| 2046 | (setq counter (1+ counter)) | ||
| 2047 | ))) | ||
| 2048 | (setq choice nil) | ||
| 2049 | (while (or (not choice) | ||
| 2050 | (not (integerp choice)) | ||
| 2051 | (< choice 1) | ||
| 2052 | (> choice (length list))) | ||
| 2053 | (setq choice | ||
| 2054 | (string-to-int | ||
| 2055 | (read-from-minibuffer "Enter No. of your choice: ")))) | ||
| 2056 | ) | ||
| 2057 | (set 'choice (1- choice)) | ||
| 2058 | (kill-buffer "*choice list*") | ||
| 2059 | |||
| 2060 | (set 'file (ada-find-src-file-in-dir (car (nth choice list)))) | ||
| 2061 | (if file | ||
| 2062 | (ada-xref-change-buffer file | ||
| 2063 | (string-to-number (nth 1 (nth choice list))) | ||
| 2064 | (string-to-number (nth 2 (nth choice list))) | ||
| 2065 | identlist | ||
| 2066 | other-frame) | ||
| 2067 | (error (concat (car (nth choice list)) " not found in src_dir"))) | ||
| 2068 | (message "This is only a (good) guess at the cross-reference.") | ||
| 2069 | )))) | ||
| 2070 | |||
| 1711 | (defun ada-xref-change-buffer | 2071 | (defun ada-xref-change-buffer |
| 1712 | (file line column identlist &optional other-frame) | 2072 | (file line column identlist &optional other-frame) |
| 1713 | "Select and display FILE, at LINE and COLUMN. The new file is | 2073 | "Select and display FILE, at LINE and COLUMN. |
| 1714 | associated with the same project file as the one for IDENTLIST. | ||
| 1715 | If we do not end on the same identifier as IDENTLIST, find the closest | 2074 | If we do not end on the same identifier as IDENTLIST, find the closest |
| 1716 | match. Kills the .ali buffer at the end. | 2075 | match. Kills the .ali buffer at the end. |
| 1717 | If OTHER-FRAME is non-nil, creates a new frame to show the file." | 2076 | If OTHER-FRAME is non-nil, creates a new frame to show the file." |
| 1718 | 2077 | ||
| 1719 | (let (prj-file | 2078 | (let (declaration-buffer) |
| 1720 | declaration-buffer | ||
| 1721 | (ali-buffer (current-buffer))) | ||
| 1722 | |||
| 1723 | ;; get the current project file for the source ada file | ||
| 1724 | (save-excursion | ||
| 1725 | (set-buffer (get-file-buffer (ada-file-of identlist))) | ||
| 1726 | (set 'prj-file ada-prj-prj-file)) | ||
| 1727 | 2079 | ||
| 1728 | ;; Select and display the destination buffer | 2080 | ;; Select and display the destination buffer |
| 1729 | (if ada-xref-other-buffer | 2081 | (if ada-xref-other-buffer |
| @@ -1736,10 +2088,6 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." | |||
| 1736 | (find-file file) | 2088 | (find-file file) |
| 1737 | ) | 2089 | ) |
| 1738 | 2090 | ||
| 1739 | ;; If the new buffer is not already associated with a project file, do it | ||
| 1740 | (unless (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)) | ||
| 1741 | (set (make-local-variable 'ada-prj-prj-file) prj-file)) | ||
| 1742 | |||
| 1743 | ;; move the cursor to the correct position | 2091 | ;; move the cursor to the correct position |
| 1744 | (push-mark) | 2092 | (push-mark) |
| 1745 | (goto-line line) | 2093 | (goto-line line) |
| @@ -1750,8 +2098,7 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." | |||
| 1750 | ;; this is probably the right one. | 2098 | ;; this is probably the right one. |
| 1751 | (unless (looking-at (ada-name-of identlist)) | 2099 | (unless (looking-at (ada-name-of identlist)) |
| 1752 | (ada-xref-search-nearest (ada-name-of identlist))) | 2100 | (ada-xref-search-nearest (ada-name-of identlist))) |
| 1753 | 2101 | )) | |
| 1754 | (kill-buffer ali-buffer))) | ||
| 1755 | 2102 | ||
| 1756 | 2103 | ||
| 1757 | (defun ada-xref-search-nearest (name) | 2104 | (defun ada-xref-search-nearest (name) |
| @@ -1878,13 +2225,28 @@ This function typically is to be hooked into `ff-file-created-hooks'." | |||
| 1878 | 2225 | ||
| 1879 | (save-some-buffers nil nil) | 2226 | (save-some-buffers nil nil) |
| 1880 | 2227 | ||
| 1881 | (ada-require-project-file) | 2228 | ;; If the current buffer is the body (as is the case when calling this |
| 2229 | ;; function from ff-file-created-hooks), then kill this temporary buffer | ||
| 2230 | (unless (interactive-p) | ||
| 2231 | (progn | ||
| 2232 | (set-buffer-modified-p nil) | ||
| 2233 | (kill-buffer (current-buffer)))) | ||
| 2234 | |||
| 1882 | 2235 | ||
| 1883 | (delete-region (point-min) (point-max)) | 2236 | ;; Make sure the current buffer is the spec (this might not be the case |
| 2237 | ;; if for instance the user was asked for a project file) | ||
| 2238 | |||
| 2239 | (unless (buffer-file-name (car (buffer-list))) | ||
| 2240 | (set-buffer (cadr (buffer-list)))) | ||
| 2241 | |||
| 2242 | ;; Make sure we have a project file (for parameters to gnatstub). Note that | ||
| 2243 | ;; this might have already been done if we have been called from the hook, | ||
| 2244 | ;; but this is not an expensive call) | ||
| 2245 | (ada-require-project-file) | ||
| 1884 | 2246 | ||
| 1885 | ;; Call the external process gnatstub | 2247 | ;; Call the external process gnatstub |
| 1886 | (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts)) | 2248 | (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts)) |
| 1887 | (filename (buffer-file-name (car (cdr (buffer-list))))) | 2249 | (filename (buffer-file-name (car (buffer-list)))) |
| 1888 | (output (concat (file-name-sans-extension filename) ".adb")) | 2250 | (output (concat (file-name-sans-extension filename) ".adb")) |
| 1889 | (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename)) | 2251 | (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename)) |
| 1890 | (buffer (get-buffer-create "*gnatstub*"))) | 2252 | (buffer (get-buffer-create "*gnatstub*"))) |
| @@ -1911,10 +2273,6 @@ This function typically is to be hooked into `ff-file-created-hooks'." | |||
| 1911 | 2273 | ||
| 1912 | ;; Else clean up the output | 2274 | ;; Else clean up the output |
| 1913 | 2275 | ||
| 1914 | ;; Kill the temporary buffer created by find-file | ||
| 1915 | (set-buffer-modified-p nil) | ||
| 1916 | (kill-buffer (current-buffer)) | ||
| 1917 | |||
| 1918 | (if (file-exists-p output) | 2276 | (if (file-exists-p output) |
| 1919 | (progn | 2277 | (progn |
| 1920 | (find-file output) | 2278 | (find-file output) |
| @@ -1925,7 +2283,6 @@ This function typically is to be hooked into `ff-file-created-hooks'." | |||
| 1925 | ) | 2283 | ) |
| 1926 | ))) | 2284 | ))) |
| 1927 | 2285 | ||
| 1928 | |||
| 1929 | (defun ada-xref-initialize () | 2286 | (defun ada-xref-initialize () |
| 1930 | "Function called by `ada-mode-hook' to initialize the ada-xref.el package. | 2287 | "Function called by `ada-mode-hook' to initialize the ada-xref.el package. |
| 1931 | For instance, it creates the gnat-specific menus, sets some hooks for | 2288 | For instance, it creates the gnat-specific menus, sets some hooks for |
| @@ -1946,6 +2303,19 @@ find-file...." | |||
| 1946 | 2303 | ||
| 1947 | ;; ----- Add to ada-mode-hook --------------------------------------------- | 2304 | ;; ----- Add to ada-mode-hook --------------------------------------------- |
| 1948 | 2305 | ||
| 2306 | ;; Use gvd or ddd as the default debugger if it was found | ||
| 2307 | ;; On windows, do not use the --tty switch for GVD, since this is | ||
| 2308 | ;; not supported. Actually, we do not use this on Unix either, since otherwise | ||
| 2309 | ;; there is no console window left in GVD, and people have to use the | ||
| 2310 | ;; Emacs one. | ||
| 2311 | ;; This must be done before initializing the Ada menu. | ||
| 2312 | (if (ada-find-file-in-dir "gvd" exec-path) | ||
| 2313 | (set 'ada-prj-default-debugger "gvd ") | ||
| 2314 | (if (ada-find-file-in-dir "gvd.exe" exec-path) | ||
| 2315 | (set 'ada-prj-default-debugger "gvd ") | ||
| 2316 | (if (ada-find-file-in-dir "ddd" exec-path) | ||
| 2317 | (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar")))) | ||
| 2318 | |||
| 1949 | ;; Set the keymap once and for all, so that the keys set by the user in his | 2319 | ;; Set the keymap once and for all, so that the keys set by the user in his |
| 1950 | ;; config file are not overwritten every time we open a new file. | 2320 | ;; config file are not overwritten every time we open a new file. |
| 1951 | (ada-add-ada-menu) | 2321 | (ada-add-ada-menu) |
| @@ -1953,12 +2323,8 @@ find-file...." | |||
| 1953 | 2323 | ||
| 1954 | (add-hook 'ada-mode-hook 'ada-xref-initialize) | 2324 | (add-hook 'ada-mode-hook 'ada-xref-initialize) |
| 1955 | 2325 | ||
| 1956 | ;; Use ddd as the default debugger if it was found | ||
| 1957 | (if (ada-find-file-in-dir "ddd" exec-path) | ||
| 1958 | (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar")) | ||
| 1959 | |||
| 1960 | ;; Initializes the cross references to the runtime library | 2326 | ;; Initializes the cross references to the runtime library |
| 1961 | (ada-initialize-runtime-library) | 2327 | (ada-initialize-runtime-library "") |
| 1962 | 2328 | ||
| 1963 | ;; Add these standard directories to the search path | 2329 | ;; Add these standard directories to the search path |
| 1964 | (set 'ada-search-directories | 2330 | (set 'ada-search-directories |