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