1 ;; ada-build.el --- Extensions to ada-mode for compiling and running -*- lexical-binding:t -*-
2 ;; Ada projects without 'make' or similar tool
4 ;; Copyright (C) 1994, 1995, 1997 - 2015 Free Software Foundation, Inc.
6 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
7 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Separate from ada-mode.el because sophisticated users don't need
27 ;; this (they use 'make' or similar tool), so it would just get in the
28 ;; way, particularly for fixing bugs in the core capabilities of
33 ;; see ada-mode.el; the current code is a complete rewrite of the
34 ;; compiling and running capabilities in Ada mode 4.01, done in 2013 by
35 ;; Stephen Leake <stephen_leake@stephe-leake.org>.
37 (require 'ada-mode-compat-24.2)
41 ;;;; User customization
43 (defgroup ada-build nil
44 "Major mode for compiling and running Ada projects in Emacs."
47 (defcustom ada-build-prompt-prj 'default
48 "Policy for finding a project file when none is currently selected."
49 :type '(choice (const default)
50 (const prompt-default)
55 (defcustom ada-build-confirm-command nil
56 "If non-nil, prompt for confirmation/edit of each command before it is run."
60 (defcustom ada-build-check-cmd
61 (concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current} -cargs -I${src_dir} ${comp_opt}")
62 "Default command to syntax check a single file.
63 Overridden by project variable `check_cmd'."
66 (defcustom ada-build-make-cmd
67 (concat "${cross_prefix}gnatmake -P${gpr_file} -o ${main} ${main} ${gnatmake_opt} "
68 "-cargs -I${src_dir} ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
69 "Default command to compile the application.
70 Overridden by project variable `make_cmd'."
73 ;; FIXME: make this more intelligent to work on Windows cmd shell?
74 ;; either detect Windows and drop "./", or expand to full path at
76 (defcustom ada-build-run-cmd "./${main}"
77 "Default command to run the application, in a spawned shell.
78 Overridden by project variable `run_cmd'."
83 (defun ada-build-replace-vars (cmd-string)
84 "Recursively expand variable references in CMD-STRING.
85 ${var} is a project variable or environment variable, $var an
88 A prefix may be specified with the format `-<prefix>${var}'; then
89 the value is expanded with the prefix prepended. If the value is
90 a list, the prefix is prepended to each list element. For
91 example, if src_dir contains `dir_1 dir_2', `-I${src_dir}'
92 expands to `-Idir_1 -Idir_2'.
94 As a special case, ${full_current} is replaced by the current
95 buffer file name including the directory and extension."
97 (while (string-match "\\(-[^-$ ]+\\)?\\${\\([^}]+\\)}" cmd-string)
98 (let ((prefix (match-string 1 cmd-string))
99 (name (match-string 2 cmd-string))
102 (when (string= name "full_current")
103 (setq value (buffer-file-name)))
106 (setq value (ada-prj-get (intern name))))
109 (setq value (getenv name)))
113 (setq cmd-string (replace-match "" t t cmd-string)))
116 (setq cmd-string (replace-match (concat prefix value) t t cmd-string)))
119 (setq cmd-string (replace-match
120 (mapconcat (lambda (x) (concat prefix x)) value " ")
124 (substitute-in-file-name cmd-string))
126 (defun ada-build-default-prj (project)
127 "Add to PROJECT the default properties list for Ada project variables used by ada-build."
131 'check_cmd ada-build-check-cmd
132 'main (when (buffer-file-name)
133 (file-name-nondirectory
134 (file-name-sans-extension (buffer-file-name))))
135 'make_cmd ada-build-make-cmd
136 'run_cmd ada-build-run-cmd
139 (defun ada-build-select-default-prj ()
140 "Create and select a new default project."
141 (let ((prj-file (expand-file-name "default.adp"))
144 (when (null (assoc prj-file ada-prj-alist))
145 (setq project (ada-prj-default)) ;; ada-build-default-prj included via ada-prj-default-compiler-alist
147 (add-to-list 'ada-prj-alist (cons prj-file project))
150 (ada-select-prj-file prj-file)
153 (defun ada-build-find-select-prj-file ()
154 "Search for a project file in the current directory, parse and select it.
155 The file must have the same basename as the project variable
156 `main' or the current buffer if `main' is nil, and extension from
157 `ada-prj-file-extensions'. Returns non-nil if a file is
158 selected, nil otherwise."
159 (let* ((base-file-name (file-name-base
160 (or (ada-prj-get 'main)
161 (file-name-nondirectory (file-name-sans-extension (buffer-file-name))))))
164 (file-name-completion base-file-name
166 (lambda (name) (member (file-name-extension name) ada-prj-file-extensions)))
168 (file-name-completion base-file-name
170 (lambda (name) (member (file-name-extension name) ada-prj-file-ext-extra)))))
173 (ada-parse-prj-file filename)
174 (ada-select-prj-file filename))
177 (defun ada-build-prompt-select-prj-file ()
178 "Search for a project file, parse and select it.
179 The file must have an extension from `ada-prj-file-extensions'.
180 Returns non-nil if a file is selected, nil otherwise."
182 (let ((ext (append ada-prj-file-extensions ada-prj-file-ext-extra))
187 "Project file: " ; prompt
189 "" ; default-filename
193 ;; this allows directories, which enables navigating
194 ;; to the desired file. We just assume the user won't
195 ;; return a directory.
196 (or (file-accessible-directory-p name)
197 (member (file-name-extension name) ext)))))
202 (when (not (equal "" filename))
203 (ada-parse-prj-file filename)
204 (ada-select-prj-file filename)
208 (defun ada-build-require-project-file ()
209 "Ensure that a project file is selected.
210 Action when no project file is currently selected is determined
211 by `ada-build-prompt-prj':
213 default - Search for a project file in the current directory with
214 the same name as the main file. If not found, use a default
215 project; no gpr file, current directory only, current file as
218 default-prompt - Search for a project file in the current
219 directory with the same name as the main file. If not found,
220 prompt for a project file; error result does not change current
223 prompt - Prompt for a project file; error result does not
224 change current project.
226 error - Throw an error (no prompt, no default project)."
227 (unless ada-prj-current-file
228 (cl-ecase ada-build-prompt-prj
230 (or (ada-build-find-select-prj-file)
231 (ada-build-select-default-prj)))
234 (or (ada-build-find-select-prj-file)
235 (ada-build-prompt-select-prj-file)))
238 (ada-build-prompt-select-prj-file))
241 (error "no project file selected"))
246 (defun ada-build-run-cmd (prj-field confirm prompt)
247 "Run the command in the PRJ-FIELD project variable.
248 If CONFIRM or `ada-build-confirm-command' are non-nil, ask for
249 user confirmation of the command, using PROMPT."
250 (ada-build-require-project-file)
251 (let ((cmd (ada-prj-get prj-field))
252 (process-environment (ada-prj-get 'proc_env)))
258 (when (or ada-build-confirm-command confirm)
259 (setq cmd (read-from-minibuffer (concat prompt ": ") cmd)))
261 (compile (ada-build-replace-vars cmd))))
263 (defun ada-build-check (&optional confirm)
264 "Run the check_cmd project variable.
265 By default, this checks the current file for syntax errors.
266 If CONFIRM is non-nil, prompt for user confirmation of the command."
268 (ada-build-run-cmd 'check_cmd confirm "check command"))
270 (defun ada-build-make (&optional confirm)
271 "Run the make_cmd project variable.
272 By default, this compiles and links the main program.
273 If CONFIRM is non-nil, prompt for user confirmation of the command."
275 (ada-build-run-cmd 'make_cmd confirm "make command"))
277 (defun ada-build-set-make (&optional confirm)
278 "Set the main project variable to the current file, then run the make_cmd project variable.
279 By default, this compiles and links the new main program.
280 If CONFIRM is non-nil, prompt for user confirmation of the command."
282 (ada-prj-put 'main (file-name-nondirectory (file-name-sans-extension (buffer-file-name))))
283 (ada-build-run-cmd 'make_cmd confirm "make command"))
285 (defun ada-build-run (&optional confirm)
286 "Run the run_cmd project variable.
287 By default, this runs the main program.
288 If CONFIRM is non-nil, prompt for user confirmation of the command."
290 (ada-build-run-cmd 'run_cmd confirm "run command"))
292 (defun ada-build-show-main ()
293 "Show current project main program filename."
295 (message "Ada mode main: %s"(ada-prj-get 'main)))
298 (add-to-list 'ada-prj-default-list 'ada-build-default-prj)