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