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)