--- /dev/null
+;;; ada-build.el --- extensions to ada-mode for compiling and running
+;;; Ada projects without 'make' or similar tool
+;;
+;;; Copyright (C) 1994, 1995, 1997 - 2013 Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <stephen_leake@member.fsf.org>
+;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Usage:
+;;
+;; Add (require 'ada-build) to your .emacs
+
+;;; Design:
+;;
+;; Separate from ada-mode.el because sophisticated users don't need
+;; this (they use 'make' or similar tool), so it would just get in the
+;; way, particularly for fixing bugs in the core capabilities of
+;; ada-mode.
+
+;;; History:
+;;
+;; see ada-mode.el; the current code is a complete rewrite of the
+;; compiling and running capabilities in Ada mode 4.01, done in 2013 by
+;; Stephen Leake <stephen_leake@stephe-leake.org>.
+
+(require 'ada-mode)
+
+;;;; User customization
+
+(defgroup ada-build nil
+ "Major mode for compiling and running Ada projects in Emacs."
+ :group 'ada)
+
+(defcustom ada-build-prompt-prj 'default
+ "Policy for finding a project file when none is currently selected."
+ :type '(choice (const default)
+ (const prompt-default)
+ (const prompt-exist)
+ (const error))
+ :group 'ada-build
+ :safe 'symbolp)
+
+(defcustom ada-build-confirm-command nil
+ "If non-nil, prompt for confirmation/edit of each command before it is run."
+ :type 'boolean
+ :group 'ada-build
+ :safe 'booleanp)
+
+(defcustom ada-build-check-cmd
+ (concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current} -cargs -I${src_dir} ${comp_opt}")
+ "Default command to syntax check a single file.
+Overridden by project variable 'check_cmd'."
+ :type 'string
+ :group 'ada-build)
+
+(defcustom ada-build-make-cmd
+ (concat "${cross_prefix}gnatmake -P${gpr_file} -o ${main} ${main} ${gnatmake_opt} "
+ "-cargs -I${src_dir} ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
+ "Default command to compile the application.
+Overridden by project variable 'make_cmd'."
+ :type 'string
+ :group 'ada-build)
+
+(defcustom ada-build-run-cmd "./${main}"
+ "Default command to run the application, in a spawned shell.
+Overridden by project variable 'run_cmd'."
+ :type 'string
+ :group 'ada-build)
+
+;;;; code
+
+(defun ada-build-replace-vars (cmd-string)
+ "Recursively expand variable references in CMD-STRING.
+${var} is a project variable or environment variable, $var an
+environment variable.
+
+A prefix may be specified with the format '-<prefix>${var}'; then
+the value is expanded with the prefix prepended. If the value is
+a list, the prefix is prepended to each list element. For
+example, if src_dir contains 'dir_1 dir_2', '-I${src_dir}'
+expands to '-Idir_1 -Idir_2'.
+
+As a special case, ${full_current} is replaced by the name
+including the directory and extension."
+
+ (while (string-match "\\(-[^-$ ]+\\)?\\${\\([^}]+\\)}" cmd-string)
+ (let ((prefix (match-string 1 cmd-string))
+ (name (match-string 2 cmd-string))
+ value)
+
+ (when (string= name "full_current")
+ (setq value (buffer-file-name)))
+
+ (when (null value)
+ (setq value (ada-prj-get (intern name))))
+
+ (when (null value)
+ (setq value (getenv name)))
+
+ (cond
+ ((null value)
+ (setq cmd-string (replace-match "" t t cmd-string)))
+
+ ((stringp value)
+ (setq cmd-string (replace-match (concat prefix value) t t cmd-string)))
+
+ ((listp value)
+ (setq cmd-string (replace-match
+ (mapconcat (lambda (x) (concat prefix x)) value " ")
+ t t cmd-string)))
+ )))
+
+ (substitute-in-file-name cmd-string))
+
+(defun ada-build-default-prj (project)
+ "Add to PROJECT the default properties list for Ada project variables used by ada-build."
+ (append
+ project
+ (list
+ 'check_cmd ada-build-check-cmd
+ 'main (when (buffer-file-name)
+ (file-name-nondirectory
+ (file-name-sans-extension (buffer-file-name))))
+ 'make_cmd ada-build-make-cmd
+ 'run_cmd ada-build-run-cmd
+ )))
+
+(defun ada-build-select-default-prj ()
+ "Create and select a new default project, with current buffer as main program."
+ (let ((prj-file (expand-file-name "default.adp"))
+ project)
+
+ (when (null (assoc prj-file ada-prj-alist))
+ (setq project (ada-prj-default)) ;; ada-build-default-prj included via ada-prj-default-compiler-alist
+
+ (add-to-list 'ada-prj-alist (cons prj-file project))
+ )
+
+ (ada-select-prj-file prj-file)
+ ))
+
+(defun ada-build-find-select-prj-file ()
+ "Search for a project file in the current directory, parse and select it.
+The file must have the same basename as the project variable
+'main' or the current buffer if 'main' is nil, and extension from
+`ada-prj-file-extensions'. Returns non-nil if a file is
+selected, nil otherwise."
+ (let* ((base-file-name (file-name-base
+ (or (ada-prj-get 'main)
+ (file-name-nondirectory (file-name-sans-extension (buffer-file-name))))))
+ (filename
+ (or
+ (file-name-completion base-file-name
+ ""
+ (lambda (name) (member (file-name-extension name) ada-prj-file-extensions)))
+
+ (file-name-completion base-file-name
+ ""
+ (lambda (name) (member (file-name-extension name) ada-prj-file-ext-extra)))))
+ )
+ (when filename
+ (ada-parse-prj-file filename)
+ (ada-select-prj-file filename))
+ ))
+
+(defun ada-build-prompt-select-prj-file ()
+ "Search for a project file, parse and select it.
+The file must have an extension from `ada-prj-file-extensions'.
+Returns non-nil if a file is selected, nil otherwise."
+ (interactive)
+ (let ((ext (append ada-prj-file-extensions ada-prj-file-ext-extra))
+ filename)
+ (condition-case err
+ (setq filename
+ (read-file-name
+ "Project file: " ; prompt
+ nil ; dir
+ "" ; default-filename
+ t ; mustmatch
+ nil; initial
+ (lambda (name)
+ ;; this allows directories, which enables navigating
+ ;; to the desired file. We just assume the user won't
+ ;; return a directory.
+ (or (file-accessible-directory-p name)
+ (member (file-name-extension name) ext)))))
+ (err
+ (setq filename nil))
+ )
+
+ (when (not (equal "" filename))
+ (ada-parse-prj-file filename)
+ (ada-select-prj-file filename)
+ t)
+ ))
+
+(defun ada-build-require-project-file ()
+ "Ensure that a project file is selected.
+Action when no project file is currently selected is determined
+by `ada-build-prompt-prj':
+
+default - Search for a project file in the current directory with
+the same name as the main file. If not found, use a default
+project; no gpr file, current directory only, current file as
+main.
+
+default-prompt - Search for a project file in the current
+directory with the same name as the main file. If not found,
+prompt for a project file; error result does not change current
+project.
+
+prompt - Prompt for a project file; error result does not
+change current project.
+
+error - Throw an error (no prompt, no default project)."
+ (unless ada-prj-current-file
+ (cl-ecase ada-build-prompt-prj
+ (default
+ (or (ada-build-find-select-prj-file)
+ (ada-build-select-default-prj)))
+
+ (default-prompt
+ (or (ada-build-find-select-prj-file)
+ (ada-build-prompt-select-prj-file)))
+
+ (prompt
+ (ada-build-prompt-select-prj-file))
+
+ (error
+ (error "no project file selected"))
+ )))
+
+;;;; user functions
+
+(defun ada-build-run-cmd (prj-field confirm prompt)
+ "Run the command in the PRJ-FIELD project variable.
+If CONFIRM or `ada-build-confirm-command' are non-nil, ask for
+user confirmation of the command, using PROMPT."
+ (ada-build-require-project-file)
+ (let ((cmd (ada-prj-get prj-field))
+ (process-environment (ada-prj-get 'proc_env)))
+
+ (unless cmd
+ (setq cmd '("")
+ confirm t))
+
+ (when (or ada-build-confirm-command confirm)
+ (setq cmd (read-from-minibuffer (concat prompt ": ") cmd)))
+
+ (compile (ada-build-replace-vars cmd))))
+
+(defun ada-build-check (&optional confirm)
+ "Run the check_cmd project variable.
+By default, this checks the current file for syntax errors.
+If CONFIRM is non-nil, prompt for user confirmation of the command."
+ (interactive "P")
+ (ada-build-run-cmd 'check_cmd confirm "check command"))
+
+(defun ada-build-make (&optional confirm)
+ "Run the make_cmd project variable.
+By default, this compiles and links the main program.
+If CONFIRM is non-nil, prompt for user confirmation of the command."
+ (interactive "P")
+ (ada-build-run-cmd 'make_cmd confirm "make command"))
+
+(defun ada-build-set-make (&optional confirm)
+ "Set the main project variable to the current file, then run the make_cmd project variable.
+By default, this compiles and links the new main program.
+If CONFIRM is non-nil, prompt for user confirmation of the command."
+ (interactive "P")
+ (ada-prj-put 'main (file-name-nondirectory (file-name-sans-extension (buffer-file-name))))
+ (ada-build-run-cmd 'make_cmd confirm "make command"))
+
+(defun ada-build-run (&optional confirm)
+ "Run the run_cmd project variable.
+By default, this runs the main program.
+If CONFIRM is non-nil, prompt for user confirmation of the command."
+ (interactive "P")
+ (ada-build-run-cmd 'run_cmd confirm "run command"))
+
+(defun ada-build-show-main ()
+ "Show current project main program filename."
+ (interactive)
+ (message "Ada mode main: %s"(ada-prj-get 'main)))
+
+;;; setup
+(add-to-list 'ada-prj-default-list 'ada-build-default-prj)
+
+(provide 'ada-build)
+;; end of file