-;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode
+;;; ada-prj.el --- GUI editing of project files for the ada-mode
-;; Copyright (C) 1998, 1999 Ada Core Technologies, Inc
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+;; Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
-;; Ada Core Technologies's version: $Revision: 1.30 $
+;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: languages, ada, project file
-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
-;; This program is distributed in the hope that it will be useful,
+;; 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; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
+
;;; This package provides a set of functions to easily edit the project
;;; files used by the ada-mode.
-;;; The only function publicly available here is `ada-prj-customize'.
-;;; Please ada-mode.el and its documentation for more information about the
-;;; project files.
-;;;
-;;; You need Emacs >= 20.2 to run this package
+;;; The only function publicly available here is `ada-customize'.
+;;; See the documentation of the Ada mode for more information on the project
+;;; files.
+;;; Internally, a project file is represented as a property list, with each
+;;; field of the project file matching one property of the list.
+
+
+;;; History:
+;;
-;; Code:
+;;; Code:
;; ----- Requirements -----------------------------------------------------
(require 'cus-edit)
+(require 'ada-xref)
+(eval-when-compile
+ (require 'ada-mode))
;; ----- Buffer local variables -------------------------------------------
-;; if non nil, then all the widgets will have the default values, instead
-;; of reading them from the project file
-(make-variable-buffer-local (defvar ada-prj-edit-use-default-values nil))
-
-;; List of the default values used for the field in the project file
-;; Mainly used to save only the modified fields into the file itself
-;; The values are hold in the properties of this variable
-(make-variable-buffer-local (defvar ada-prj-default nil))
-
-(make-variable-buffer-local (defvar ada-prj-widget-prj-dir nil))
-(make-variable-buffer-local (defvar ada-prj-widget-src-dir nil))
-(make-variable-buffer-local (defvar ada-prj-widget-obj-dir nil))
-(make-variable-buffer-local (defvar ada-prj-widget-main nil))
-(make-variable-buffer-local (defvar ada-prj-widget-comp-opt nil))
-(make-variable-buffer-local (defvar ada-prj-widget-bind-opt nil))
-(make-variable-buffer-local (defvar ada-prj-widget-link-opt nil))
-(make-variable-buffer-local (defvar ada-prj-widget-remote-machine nil))
-(make-variable-buffer-local (defvar ada-prj-widget-comp-cmd nil))
-(make-variable-buffer-local (defvar ada-prj-widget-make-cmd nil))
-(make-variable-buffer-local (defvar ada-prj-widget-run-cmd nil))
-(make-variable-buffer-local (defvar ada-prj-widget-debug-cmd nil))
-(make-variable-buffer-local (defvar ada-prj-widget-cross-prefix nil))
-
-;; ------ Functions -------------------------------------------------------
-
-(defun ada-prj-add-ada-menu ()
- "Add a new submenu to the Ada menu"
- (interactive)
- (if ada-xemacs
- (progn
- (add-menu-button '("Ada" "Project") ["New/Edit" ada-customize t] "Associate")
- )
- (let ((prj-menu (lookup-key ada-mode-map [menu-bar Ada Project])))
- (define-key prj-menu [New] '("New/Edit" . ada-customize)))
- ))
+(defvar ada-prj-current-values nil
+ "Hold the current value of the fields, This is a property list.")
+(make-variable-buffer-local 'ada-prj-current-values)
-(defun ada-prj-add-keymap ()
- "Add new keybindings for ada-prj"
- (define-key ada-mode-map "\C-cu" 'ada-customize))
+(defvar ada-prj-default-values nil
+ "Hold the default value for the fields, This is a property list.")
+(make-variable-buffer-local 'ada-prj-default-values)
-(defun ada-customize (&optional new-file)
- "Edit the project file associated with the current buffer, or
-a new one if none is found"
+(defvar ada-prj-ada-buffer nil
+ "Indicates what Ada source file was being edited.")
+
+(defvar ada-old-cross-prefix nil
+ "The cross-prefix associated with the currently loaded runtime library.")
+
+
+;; ----- Functions --------------------------------------------------------
+
+(defun ada-prj-new ()
+ "Open a new project file."
(interactive)
- (if new-file
- (progn
- (setq ada-prj-edit-use-default-values t)
- (kill-local-variable 'ada-prj-prj-file)
- (ada-prj-customize)
- (setq ada-prj-edit-use-default-values nil))
- (ada-prj-customize)))
+ (let* ((prj
+ (if (and ada-prj-default-project-file
+ (not (string= ada-prj-default-project-file "")))
+ ada-prj-default-project-file
+ "default.adp"))
+ (filename (read-file-name "Project file: "
+ (if prj "" nil)
+ nil
+ nil
+ prj)))
+ (if (not (string= (file-name-extension filename t) ".adp"))
+ (error "File name extension for project files must be .adp"))
+
+ (ada-customize nil filename)))
+
+(defun ada-prj-edit ()
+ "Editing the project file associated with the current Ada buffer.
+If there is none, opens a new project file"
+ (interactive)
+ (if ada-prj-default-project-file
+ (ada-customize)
+ (ada-prj-new)))
+
+(defun ada-prj-initialize-values (symbol ada-buffer filename)
+ "Set SYMBOL to the property list of the project file FILENAME.
+If FILENAME is null, read the file associated with ADA-BUFFER. If no
+project file is found, returns the default values."
+;; FIXME: rationalize arguments; make ada-buffer optional?
+ (if (and filename
+ (not (string= filename ""))
+ (assoc filename ada-xref-project-files))
+ (set symbol (copy-sequence (cdr (assoc filename ada-xref-project-files))))
+
+ ;; Set default values (except for the file name if this was given
+ ;; in the buffer
+ (ada-xref-set-default-prj-values symbol ada-buffer)
+ (if (and filename (not (string= filename "")))
+ (set symbol (plist-put (eval symbol) 'filename filename)))
+ ))
+
+
+(defun ada-prj-save-specific-option (field)
+ "Return the string to print in the project file to save FIELD.
+If the current value of FIELD is the default value, returns an empty string."
+ (if (string= (plist-get ada-prj-current-values field)
+ (plist-get ada-prj-default-values field))
+ ""
+ (concat (symbol-name field)
+ "=" (plist-get ada-prj-current-values field) "\n")))
(defun ada-prj-save ()
- "save the edited project file"
+ "Save the edited project file."
(interactive)
- (let ((file-name (widget-value ada-prj-widget-prj-dir))
- value output)
- (setq output
- (concat
- (ada-prj-set-list "src_dir" (widget-value ada-prj-widget-src-dir))
- "\n"
- (ada-prj-set-list "obj_dir" (widget-value ada-prj-widget-obj-dir))
- "\n"
- (unless (string= (setq value (widget-value ada-prj-widget-comp-opt))
- (get 'ada-prj-default 'comp_opt))
- (concat "comp_opt=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-bind-opt))
- (get 'ada-prj-default 'bind_opt))
- (concat "bind_opt=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-link-opt))
- (get 'ada-prj-default 'link_opt))
- (concat "link_opt=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-main))
- (get 'ada-prj-default 'main))
- (concat "main=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-cross-prefix))
- (get 'ada-prj-default 'cross-prefix))
- (concat "cross_prefix=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-remote-machine))
- (get 'ada-prj-default 'remote-machine))
- (concat "remote_machine=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-comp-cmd))
- (get 'ada-prj-default 'comp_cmd))
- (concat "comp_cmd=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-make-cmd))
- (get 'ada-prj-default 'make_cmd))
- (concat "make_cmd=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-run-cmd))
- (get 'ada-prj-default 'run_cmd))
- (concat "run_cmd=" value "\n"))
- (unless (string= (setq value (widget-value ada-prj-widget-debug-cmd))
- (get 'ada-prj-default 'debug_cmd))
- (concat "debug_cmd=" value "\n"))
- ))
+ (let ((file-name (plist-get ada-prj-current-values 'filename))
+ output)
+ (set 'output
+ (concat
+
+ ;; Save the fields that do not depend on the current buffer
+ ;; only if they are different from the default value
+
+ (ada-prj-save-specific-option 'comp_opt)
+ (ada-prj-save-specific-option 'bind_opt)
+ (ada-prj-save-specific-option 'link_opt)
+ (ada-prj-save-specific-option 'gnatmake_opt)
+ (ada-prj-save-specific-option 'gnatfind_opt)
+ (ada-prj-save-specific-option 'cross_prefix)
+ (ada-prj-save-specific-option 'remote_machine)
+ (ada-prj-save-specific-option 'debug_cmd)
+
+ ;; Always save the fields that depend on the current buffer
+ "main=" (plist-get ada-prj-current-values 'main) "\n"
+ "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n"
+ "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n"
+ (ada-prj-set-list "check_cmd"
+ (plist-get ada-prj-current-values 'check_cmd)) "\n"
+ (ada-prj-set-list "make_cmd"
+ (plist-get ada-prj-current-values 'make_cmd)) "\n"
+ (ada-prj-set-list "comp_cmd"
+ (plist-get ada-prj-current-values 'comp_cmd)) "\n"
+ (ada-prj-set-list "run_cmd"
+ (plist-get ada-prj-current-values 'run_cmd)) "\n"
+ (ada-prj-set-list "src_dir"
+ (plist-get ada-prj-current-values 'src_dir)
+ t) "\n"
+ (ada-prj-set-list "obj_dir"
+ (plist-get ada-prj-current-values 'obj_dir)
+ t) "\n"
+ (ada-prj-set-list "debug_pre_cmd"
+ (plist-get ada-prj-current-values 'debug_pre_cmd))
+ "\n"
+ (ada-prj-set-list "debug_post_cmd"
+ (plist-get ada-prj-current-values 'debug_post_cmd))
+ "\n"
+ ))
+
(find-file file-name)
(erase-buffer)
(insert output)
(kill-buffer nil)
;; kill the editor buffer
- (kill-buffer "*Customize Ada Mode*")
+ (kill-buffer "*Edit Ada Mode Project*")
- ;; automatically associates the current buffer with the
- ;; new project file
- (make-local-variable 'ada-prj-prj-file)
- (setq ada-prj-prj-file file-name)
+ ;; automatically set the new project file as the active one
+ (set 'ada-prj-default-project-file file-name)
- ;; force emacs to reread the project files
- (ada-reread-prj-file t)
+ ;; force Emacs to reread the project files
+ (ada-reread-prj-file file-name)
)
)
-(defun ada-prj-customize ()
- "Edit the project file whose name is given by prj-file."
- (let* ((old-name (buffer-file-name))
- prj-file)
-
- (unless old-name
- (error
- "No file name given for this buffer ! You need to open a file first"))
-
- ;; Find the project file associated with the buffer
- (setq prj-file (ada-prj-get-prj-dir old-name))
-
- (switch-to-buffer "*Customize Ada Mode*")
- (kill-all-local-variables)
-
- ;; Find the default values
- (setq ada-prj-default nil)
- (put 'ada-prj-default 'src_dir (list (file-name-directory old-name)))
- (put 'ada-prj-default 'obj_dir (list (file-name-directory old-name)))
- (put 'ada-prj-default 'comp_opt "")
- (put 'ada-prj-default 'bind_opt "")
- (put 'ada-prj-default 'link_opt "")
- (put 'ada-prj-default 'main "")
- (put 'ada-prj-default 'cross_prefix "")
- (put 'ada-prj-default 'remote_machine "")
- (put 'ada-prj-default 'comp_cmd
- (concat "cd " (file-name-directory old-name) " && "
- ada-prj-default-comp-cmd))
- (put 'ada-prj-default 'make_cmd
- (concat "cd " (file-name-directory old-name) " && "
- ada-prj-default-make-cmd))
- (put 'ada-prj-default 'run_cmd (if is-windows "${main}.exe" "${main}"))
- (put 'ada-prj-default 'debug_cmd
- (if is-windows "${cross_prefix}gdb ${main}.exe"
- "${cross_prefix}gdb ${main}"))
-
- (let ((inhibit-read-only t))
- (erase-buffer))
-
- ;;; Overlay-lists is not defined on XEmacs
- (if (fboundp 'overlay-lists)
- (let ((all (overlay-lists)))
- ;; Delete all the overlays.
- (mapcar 'delete-overlay (car all))
- (mapcar 'delete-overlay (cdr all))))
-
- (use-local-map widget-keymap)
- (local-set-key "\C-x\C-s" 'ada-prj-save)
-
- (widget-insert "
-----------------------------------------------------------------
--- Customize your emacs ada mode for the current application --
-----------------------------------------------------------------
-This buffer will allow you to create easily a project file for your application.
-This file will tell emacs where to find the ada sources, the cross-referencing
-informations, how to compile and run your application, ...
-
-Please use the RETURN key, or middle mouse button to activate the fields.\n\n")
-
- ;; Reset Button
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (setq ada-prj-edit-use-default-values t)
- (kill-buffer nil)
- (ada-prj-customize)
- (setq ada-prj-edit-use-default-values nil)
- )
- "Reset to Default Values")
- (widget-insert "\n")
+(defun ada-prj-load-from-file (symbol)
+ "Load SYMBOL value from file. One item per line should be found in the file."
+ (save-excursion
+ (let ((file (read-file-name "File name: " nil nil t))
+ (buffer (current-buffer))
+ line
+ list)
+ (find-file file)
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (set 'line (buffer-substring-no-properties
+ (point) (save-excursion (end-of-line) (point))))
+ (add-to-list 'list line)
+ (forward-line 1)
+ )
+ (kill-buffer nil)
+ (set-buffer buffer)
+ (set 'ada-prj-current-values
+ (plist-put ada-prj-current-values
+ symbol
+ (append (plist-get ada-prj-current-values symbol)
+ (reverse list))))
+ )
+ (ada-prj-display-page 2)
+ ))
+
+(defun ada-prj-subdirs-of (dir)
+ "Return a list of all the subdirectories of DIR, recursively."
+ (let ((subdirs (directory-files dir t "^[^.].*"))
+ (dirlist (list dir)))
+ (while subdirs
+ (if (file-directory-p (car subdirs))
+ (let ((sub (ada-prj-subdirs-of (car subdirs))))
+ (if sub
+ (set 'dirlist (append sub dirlist)))))
+ (set 'subdirs (cdr subdirs)))
+ dirlist))
+
+(defun ada-prj-load-directory (field &optional file-name)
+ "Append to FIELD in the current project the subdirectories of FILE-NAME.
+If FILE-NAME is nil, ask the user for the name."
+
+ ;; Do not use an external dialog for this, since it wouldn't allow
+ ;; the user to select a directory
+ (let ((use-dialog-box nil))
+ (unless file-name
+ (set 'file-name (read-file-name "Root directory: " nil nil t))))
+
+ (set 'ada-prj-current-values
+ (plist-put ada-prj-current-values
+ field
+ (append (plist-get ada-prj-current-values field)
+ (reverse (ada-prj-subdirs-of
+ (expand-file-name file-name))))))
+ (ada-prj-display-page 2))
+
+(defun ada-prj-display-page (tab-num)
+ "Display page TAB-NUM in the notebook.
+The current buffer must be the project editing buffer."
+
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+
+ ;; Widget support in Emacs 21 requires that we clear the buffer first
+ (if (and (not (featurep 'xemacs)) (>= emacs-major-version 21))
+ (progn
+ (setq widget-field-new nil
+ widget-field-list nil)
+ (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists)))
+ (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
+
+ ;; Display the tabs
+
+ (widget-insert "\n Project configuration.\n
+ ___________ ____________ ____________ ____________ ____________\n / ")
+ (widget-create 'push-button :notify
+ (lambda (&rest dummy) (ada-prj-display-page 1)) "General")
+ (widget-insert " \\ / ")
+ (widget-create 'push-button :notify
+ (lambda (&rest dummy) (ada-prj-display-page 2)) "Paths")
+ (widget-insert " \\ / ")
+ (widget-create 'push-button :notify
+ (lambda (&rest dummy) (ada-prj-display-page 3)) "Switches")
+ (widget-insert " \\ / ")
+ (widget-create 'push-button :notify
+ (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu")
+ (widget-insert " \\ / ")
+ (widget-create 'push-button :notify
+ (lambda (&rest dummy) (ada-prj-display-page 5)) "Debugger")
+ (widget-insert " \\\n")
+
+ ;; Display the currently selected page
+
+ (cond
+
+ ;;
+ ;; First page (General)
+ ;;
+ ((= tab-num 1)
+ (widget-insert "/ \\/______________\\/______________\\/______________\\/______________\\\n")
+
+ (widget-insert "Project file name:\n")
+ (widget-insert (plist-get ada-prj-current-values 'filename))
+ (widget-insert "\n\n")
+; (ada-prj-field 'filename "Project file name"
+; "Enter the name and directory of the project
+; file. The name of the file should be the
+; name of the project itself. The extension
+; must be .adp")
+; (ada-prj-field 'casing "Casing Exceptions Dictionnaries"
+; "List of files that contain casing exception
+; dictionnaries. All these files contain one
+; identifier per line, with a special casing.
+; The first file has the highest priority."
+; t)
+ (ada-prj-field 'main "Executable file name"
+"Name of the executable generated when you
+compile your application. This should include
+the full directory name, using ${build_dir} if
+you wish.")
+ (ada-prj-field 'main_unit "File name of the main unit"
+"Name of the file to pass to the gnatmake command,
+and that will create the executable.
+This should not include any directory specification.")
+ (ada-prj-field 'build_dir "Build directory"
+ "Reference directory for relative paths in
+src_dir and obj_dir below. This is also the directory
+where the compilation is done.")
+ (ada-prj-field 'remote_machine "Name of the remote machine (if any)"
+"If you want to remotely compile, debug and
+run your application, specify the name of a
+remote machine here. This capability requires
+the 'rsh' protocol on the remote machine.")
+ (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain"
+"When working on multiple cross targets, it is
+most convenient to specify the prefix of the
+tool chain here. For instance, on PowerPc
+vxworks, you would enter 'powerpc-wrs-vxworks-'.
+To use JGNAT, enter 'j'.")
+ )
- ;; Create local variables with their initial value
- (setq ada-prj-widget-prj-dir
- (ada-prj-new 'ada-prj-widget-prj-dir nil "" prj-file
- "\nName and directory of the project file.
-Put a new name here if you want to create a new project file\n"))
-
- (setq ada-prj-widget-src-dir
- (ada-prj-list 'ada-prj-widget-src-dir prj-file "src_dir"
- (get 'ada-prj-default 'src_dir)
- "\nYou should enter below all the directories where emacs
-will find your ada sources for the current application\n"))
-
- (setq ada-prj-widget-obj-dir
- (ada-prj-list 'ada-prj-widget-obj-dir prj-file "obj_dir"
- (get 'ada-prj-default 'obj_dir)
- "\nBelow are the directories where the object files generated
-by the compiler will be found. This files are required for the cross-referencing
-capabilities of the emacs ada-mode.\n"))
-
- (setq ada-prj-widget-comp-opt
- (ada-prj-new 'ada-prj-widget-comp-opt prj-file "comp_opt"
- (get 'ada-prj-default 'comp_opt)
- "\nPut below the compiler switches.\n"))
-
- (setq ada-prj-widget-bind-opt
- (ada-prj-new 'ada-prj-widget-bind-opt prj-file "bind_opt"
- (get 'ada-prj-default 'bind_opt)
- "\nPut below the binder switches.\n"))
-
- (setq ada-prj-widget-link-opt
- (ada-prj-new 'ada-prj-widget-link-opt prj-file "link_opt"
- (get 'ada-prj-default 'link_opt)
- "\nPut below the linker switches.\n"))
-
- (setq ada-prj-widget-main
- (ada-prj-new 'ada-prj-widget-main prj-file "main"
- (file-name-sans-extension old-name)
- "\nPut below the name of the main program for your application\n"))
-
- (setq ada-prj-widget-cross-prefix
- (ada-prj-new 'ada-prj-widget-cross-prefix prj-file "cross_prefix"
- (get 'ada-prj-default 'cross_prefix)
- "\nIf you are using a cross compiler, you might want to
-set the following variable so that the correct compiler is used by default\n"))
-
- (setq ada-prj-widget-remote-machine
- (ada-prj-new 'ada-prj-widget-remote-machine prj-file "remote_machine"
- (get 'ada-prj-default 'remote_machine)
- "\nName of the machine to log on before a compilation.
-Leave an empty field if you want to compile on the local machine.
-This will not work on Windows NT, since we only do a 'rsh' to the
-remote machine and then issue the command. \n"))
-
- (widget-insert "\n
--------------------------------------------------------------------------------
- / \\ !! Advanced Users !! : For the following commands, you may use
- / | \\ a somewhat more complicated syntax to describe them. If you
- / | \\ use some special fields, they will be replaced at run-time by
- / | \\ the variables defined above.
- / | \\ These special fields are : ${remote_machine}
- / o \\ -aI${src_dir} -I${src_dir} -aO${obj_dir} ${comp_opt}
- ------------- ${bind_opt} ${link_opt} ${main} ${cross_prefix}
-
-The easiest way is to ignore this possibility. These fields are intended only
-for user who really understand what `variable substitution' means.
--------------------------------------------------------------------------------\n")
-
- (setq ada-prj-widget-comp-cmd
- (ada-prj-new 'ada-prj-widget-comp-cmd prj-file "comp_cmd"
- (get 'ada-prj-default 'comp_cmd)
- "\nPut below the command used to compile ONE file.
-The name of the file to compile will be added at the end of the command.
-This command will also be used to check the file.\n"))
-
- (setq ada-prj-widget-make-cmd
- (ada-prj-new 'ada-prj-widget-make-cmd prj-file "make_cmd"
- (get 'ada-prj-default 'make_cmd)
- "\nPut below the command used to compile the whole application.\n"))
-
- (setq ada-prj-widget-run-cmd
- (ada-prj-new 'ada-prj-widget-run-cmd prj-file "run_cmd"
- (get 'ada-prj-default 'run_cmd)
- "\nPut below the command used to run your application.\n"))
-
- (setq ada-prj-widget-debug-cmd
- (ada-prj-new 'ada-prj-widget-run-cmd prj-file "debug_cmd"
- (get 'ada-prj-default 'debug_cmd)
- "\nPut below the command used to launch the debugger on your application.\n"))
-
- ;; the two buttons to validate or cancel the modification
- (widget-insert "\nWhen you have finish completing the above fields, choose one of the two buttons
-below, to validate or cancel your modifications.
-If you choose `OK', your settings will be saved to the file whose name is given above.\n")
-
- (widget-create 'push-button
- :notify (lambda (&rest ignore) (ada-prj-save))
- "OK")
-
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (kill-buffer nil))
- "Cancel")
- (widget-insert "\n")
+ ;;
+ ;; Second page (Paths)
+ ;;
+ ((= tab-num 2)
+ (if (not (equal (plist-get ada-prj-current-values 'cross_prefix)
+ ada-old-cross-prefix))
+ (progn
+ (setq ada-old-cross-prefix
+ (plist-get ada-prj-current-values 'cross_prefix))
+ (ada-initialize-runtime-library ada-old-cross-prefix)))
+
+
+ (widget-insert "/_____________\\/ \\/______________\\/______________\\/______________\\\n")
+ (ada-prj-field 'src_dir "Source directories"
+"Enter the list of directories where your Ada
+sources can be found. These directories will be
+used for the cross-references and for the default
+compilation commands.
+Note that src_dir includes both the build directory
+and the standard runtime."
+ t t
+ (mapconcat (lambda(x)
+ (concat " " x))
+ ada-xref-runtime-library-specs-path
+ "\n")
+ )
+ (widget-insert "\n\n")
+
+ (ada-prj-field 'obj_dir "Object directories"
+"Enter the list of directories where the GNAT
+library files (ALI files) can be found. These
+files are used for cross-references and by the
+gnatmake command.
+Note that obj_dir includes both the build directory
+and the standard runtime."
+ t t
+ (mapconcat (lambda(x)
+ (concat " " x))
+ ada-xref-runtime-library-ali-path
+ "\n")
+ )
+ (widget-insert "\n\n")
+ )
+ ;;
+ ;; Third page (Switches)
+ ;;
+ ((= tab-num 3)
+ (widget-insert "/_____________\\/______________\\/ \\/______________\\/______________\\\n")
+ (ada-prj-field 'comp_opt "Switches for the compiler"
+"These switches are used in the default
+compilation commands, both for compiling a
+single file and rebuilding the whole project")
+ (ada-prj-field 'bind_opt "Switches for the binder"
+"These switches are used in the default build
+command and are passed to the binder")
+ (ada-prj-field 'link_opt "Switches for the linker"
+"These switches are used in the default build
+command and are passed to the linker")
+ (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
+"These switches are used in the default gnatmake
+command.")
+ (ada-prj-field 'gnatfind_opt "Switches for gnatfind"
+"The command gnatfind is run every time the Ada/Goto/List_References menu.
+You should for instance add -a if you are working in an environment
+where most ALI files are write-protected, since otherwise they get
+ignored by gnatfind and you don't see the references within.")
+ )
- ;; if it exists, kill the project file buffer
- (if (and prj-file
- (get-file-buffer prj-file))
- (kill-buffer (get-file-buffer prj-file)))
+ ;;
+ ;; Fourth page
+ ;;
+ ((= tab-num 4)
+ (widget-insert "/_____________\\/______________\\/______________\\/ \\/______________\\\n")
+ (widget-insert
+"All the fields below can use variable substitution The syntax is ${name},
+where name is the name that appears after the Help buttons in this buffer. As
+a special case, ${current} is replaced with the name of the file currently
+edited, with directory name but no extension, whereas ${full_current} is
+replaced with the name of the current file with directory name and
+extension.\n")
+ (widget-insert
+"The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to
+${src_dir} and ${obj_dir} before running the compilation commands, so that you
+don't need to specify the -aI and -aO switches on the command line\n")
+ (widget-insert
+"You can reference any environment variable using the same ${...} syntax as
+above, and put the name of the variable between the quotes.\n\n")
+ (ada-prj-field 'check_cmd
+ "Check syntax of a single file (menu Ada->Check File)"
+"This command is run to check the syntax and semantics of a file.
+The file name is added at the end of this command." t)
+ (ada-prj-field 'comp_cmd
+ "Compiling a single file (menu Ada->Compile File)"
+"This command is run when the recompilation
+of a single file is needed. The file name is
+added at the end of this command." t)
+ (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)"
+"This command is run when you want to rebuild
+your whole application. It is never issues
+automatically and you will need to ask for it.
+If remote_machine has been set, this command
+will be executed on the remote machine." t)
+ (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)"
+"This command specifies how to run the
+application, including any switch you need to
+specify. If remote_machine has been set, this
+command will be executed on the remote host." t)
+ )
- (widget-setup)
- (beginning-of-buffer)
+ ;;
+ ;; Fifth page
+ ;;
+ ((= tab-num 5)
+ (widget-insert "/_____________\\/______________\\/______________\\/______________\\/ \\\n")
+ (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the
+debugger"
+"The following commands are executed one after the other before starting
+the debugger. These can be used to set up your environment." t)
+
+ (ada-prj-field 'debug_cmd "Debugging the application"
+"Specifies how to debug the application, possibly
+remotely if remote_machine has been set. We
+recommend the following debuggers:
+ > gdb
+ > gvd --tty
+ > ddd --tty -fullname -toolbar")
+
+ (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger"
+"The following commands are executed one in the debugger once it has been
+started. These can be used to initialize the debugger, for instance to
+connect to the target when working with cross-environments" t)
)
+
+ )
+
+
+ (widget-insert "______________________________________________________________________\n\n ")
+ (widget-create 'push-button
+ :notify (lambda (&rest ignore)
+ (ada-xref-set-default-prj-values
+ 'ada-prj-current-values ada-prj-ada-buffer)
+ (ada-prj-display-page 1))
+ "Reset to Default Values")
+ (widget-insert " ")
+ (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil))
+ "Cancel")
+ (widget-insert " ")
+ (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save))
+ "Save")
+ (widget-insert "\n\n")
+
+ (widget-setup)
+ (with-no-warnings
+ (beginning-of-buffer))
)
-;; ---------------- Utilities --------------------------------
+(defun ada-customize (&optional new-file filename)
+ "Edit the project file associated with the current buffer.
+If there is none or NEW-FILE is non-nil, make a new one.
+If FILENAME is given, edit that file."
+ (interactive)
-(defun ada-prj-new (variable prj-file text default message)
- "Create a buffer-local text variable, whose value is either read in
-the prj-file or default
-Then adds a text field (with MESSAGE), and returns the created widget"
-
- ;; create local variable
- (make-local-variable variable)
- (let ((value default)
- (regexp (concat "^" text "=\\(.*\\)")))
- ;; if the project file exists
- (if (and prj-file (not ada-prj-edit-use-default-values)
- (file-readable-p prj-file))
- ;; find the value
- (save-excursion
- (find-file prj-file)
- (beginning-of-buffer)
- (if (re-search-forward regexp nil t)
- (setq value (match-string 1)))
- ))
- ;; assign a new value to the variable
- (setq variable value))
-
- (widget-insert message)
-
- (widget-create 'editable-field
- :format (if (string= text "") "%v"
- (concat text "= %v"))
- :keymap widget-keymap
- variable))
-
-
-(defun ada-prj-list (variable prj-file text default message)
- "Create a buffer-local list variable, whose value is either read in
-the prj-file or default
-Then adds a list widget (with MESSAGE), and returns the created widget"
-
- ;; create local variable
- (make-local-variable variable)
- (let ((value nil)
- (regexp (concat "^" text "=\\(.*\\)")))
- ;; if the project file exists
- (if (and prj-file (not ada-prj-edit-use-default-values)
- (file-readable-p prj-file))
- ;; find the value
- (save-excursion
- (find-file prj-file)
- (goto-char (point-min))
- ;; for each line, add its value
- (while
- (re-search-forward regexp nil t)
- (progn
- (setq value (cons (match-string 1) value)))
- )))
-
- ;; assign a new value to the variable
- (setq variable
- (if value (reverse value) default)))
-
- (widget-insert message)
- (widget-create 'editable-list
- :entry-format (concat text "= %i %d %v")
- :value variable
- (list 'editable-field :keymap widget-keymap)))
-
-(defun ada-prj-set-list (string ada-dir-list)
- "Creates a single string of blank-separated directory names"
- (mapconcat (lambda (x)
- (concat string "="
- x
- (unless (string=
- (substring x -1)
- "/")
- "/")))
- ada-dir-list "\n"))
-
-(defun ada-prj-get-prj-dir (&optional ada-file)
- "returns a string which is the directory/name of the prj file.
-If no-standard-prj is t, do not use the default algorithm, just
-use a default name"
- (unless ada-file
- (setq ada-file (buffer-file-name)))
+ (let ((ada-buffer (current-buffer))
+ (inhibit-read-only t))
- (save-excursion
- (set-buffer (get-file-buffer ada-file))
- (if ada-prj-edit-use-default-values
- (concat (file-name-sans-extension ada-file)
- ada-project-file-extension)
-
- (let ((prj-file (ada-prj-find-prj-file t)))
- (if (or (not prj-file)
- (not (file-exists-p prj-file))
- )
- (setq prj-file
- (concat (file-name-sans-extension ada-file)
- ada-project-file-extension)))
- prj-file)
- ))
- )
+ ;; We can only edit interactively the standard ada-mode project files. If
+ ;; the user is using other formats for the project file (through hooks in
+ ;; `ada-load-project-hook', we simply edit the file
+ (if (and (not new-file)
+ (or ada-prj-default-project-file filename)
+ (string= (file-name-extension
+ (or filename ada-prj-default-project-file))
+ "gpr"))
+ (progn
+ (find-file ada-prj-default-project-file)
+ (add-hook 'after-save-hook 'ada-reread-prj-file t t)
+ )
-;; Initializations for the package
-(add-hook 'ada-mode-hook 'ada-prj-add-ada-menu)
+ (if filename
+ (ada-reread-prj-file filename)
+ (if (not (string= ada-prj-default-project-file ""))
+ (ada-reread-prj-file ada-prj-default-project-file)
+ (ada-reread-prj-file)))
-;; Set the keymap once and for all, so that the keys set by the user in his
-;; config file are not overwritten every time we open a new file.
-(ada-prj-add-keymap)
+ ;; Else start the interactive editor
+ (switch-to-buffer "*Edit Ada Mode Project*")
-(provide 'ada-prj)
-;;; package ada-prj.el ends here
+ (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
+ (ada-prj-initialize-values 'ada-prj-current-values
+ ada-buffer
+ ada-prj-default-project-file)
+
+ (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
+
+ (use-local-map (copy-keymap custom-mode-map))
+ (local-set-key "\C-x\C-s" 'ada-prj-save)
+
+ (make-local-variable 'widget-keymap)
+ (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
+ (set (make-local-variable 'ada-old-cross-prefix)
+ (ada-xref-get-project-field 'cross-prefix))
+ (ada-prj-display-page 1)
+ )))
+
+;; ---------------- Utilities --------------------------------
+
+(defun ada-prj-set-list (string ada-list &optional is-directory)
+ "Prepend STRING to strings in ADA-LIST, return new-line separated string.
+If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly
+converted to a directory name."
+
+ (mapconcat (lambda (x) (concat string "="
+ (if is-directory
+ (file-name-as-directory x)
+ x)))
+ ada-list "\n"))
+
+
+(defun ada-prj-field-modified (widget &rest dummy)
+ "Callback for modification of WIDGET.
+Remaining args DUMMY are ignored.
+Save the change in `ada-prj-current-values' so that selecting
+another page and coming back keeps the new value."
+ (set 'ada-prj-current-values
+ (plist-put ada-prj-current-values
+ (widget-get widget ':prj-field)
+ (widget-value widget))))
+
+(defun ada-prj-display-help (widget widget-modified event)
+ "Callback for help button in WIDGET.
+Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
+ (let ((text (widget-get widget 'prj-help)))
+ (if event
+ ;; If we have a mouse-event, popup a menu
+ (widget-choose "Help"
+ (mapcar (lambda (a) (cons a t))
+ (split-string text "\n"))
+ event)
+ ;; Else display the help string just before the next group of
+ ;; variables
+ (momentary-string-display
+ (concat "*****Help*****\n" text "\n**************\n")
+ (save-excursion (forward-line) (beginning-of-line) (point)))
+ )))
+
+(defun ada-prj-show-value (widget widget-modified event)
+ "Show the current field value in WIDGET.
+Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
+ (let* ((field (widget-get widget ':prj-field))
+ (value (plist-get ada-prj-current-values field))
+ (inhibit-read-only t)
+ w)
+
+ ;; If the other widget is already visible, delete it
+ (if (widget-get widget 'prj-other-widget)
+ (progn
+ (widget-delete (widget-get widget 'prj-other-widget))
+ (widget-put widget 'prj-other-widget nil)
+ (widget-put widget ':prj-field field)
+ (widget-default-value-set widget "Show Value")
+ )
+
+ ;; Else create it
+ (save-excursion
+ (mouse-set-point event)
+ (forward-line 1)
+ (beginning-of-line)
+ (setq w (widget-create 'editable-list
+ :entry-format "%i%d %v"
+ :notify 'ada-prj-field-modified
+ :help-echo (widget-get widget 'prj-help)
+ :value value
+ (list 'editable-field :keymap widget-keymap)))
+ (widget-put widget 'prj-other-widget w)
+ (widget-put w ':prj-field field)
+ (widget-put widget ':prj-field field)
+ (widget-default-value-set widget "Hide Value")
+ )
+ )
+ (widget-setup)
+ ))
+
+(defun ada-prj-field (field text help-text &optional is-list is-paths after-text)
+ "Create a widget to edit FIELD in the current buffer.
+TEXT is a short explanation of what the field means, whereas HELP-TEXT
+is the text displayed when the user pressed the help button.
+If IS-LIST is non-nil, the field contains a list. Otherwise, it contains
+a single string.
+if IS-PATHS is true, some special buttons are added to load paths,...
+AFTER-TEXT is inserted just after the widget."
+ (let ((value (plist-get ada-prj-current-values field))
+ (inhibit-read-only t)
+ widget)
+ (unless value
+ (set 'value
+ (if is-list '() "")))
+ (widget-insert text)
+ (widget-insert ":")
+ (move-to-column 54 t)
+ (widget-put (widget-create 'push-button
+ :notify 'ada-prj-display-help
+ "Help")
+ 'prj-help
+ help-text)
+ (widget-insert (concat " (" (symbol-name field) ")\n"))
+ (if is-paths
+ (progn
+ (widget-create 'push-button
+ :notify
+ (list 'lambda '(&rest dummy) '(interactive)
+ (list 'ada-prj-load-from-file
+ (list 'quote field)))
+ "Load From File")
+ (widget-insert " ")
+ (widget-create 'push-button
+ :notify
+ (list 'lambda '(&rest dummy) '(interactive)
+ (list 'ada-prj-load-directory
+ (list 'quote field)))
+ "Load Recursive Directory")
+ (widget-insert "\n ${build_dir}\n")))
+
+ (set 'widget
+ (if is-list
+ (if (< (length value) 15)
+ (widget-create 'editable-list
+ :entry-format "%i%d %v"
+ :notify 'ada-prj-field-modified
+ :help-echo help-text
+ :value value
+ (list 'editable-field :keymap widget-keymap))
+
+ (let ((w (widget-create 'push-button
+ :notify 'ada-prj-show-value
+ "Show value")))
+ (widget-insert "\n")
+ (widget-put w 'prj-help help-text)
+ (widget-put w 'prj-other-widget nil)
+ w)
+ )
+ (widget-create 'editable-field
+ :format "%v"
+ :notify 'ada-prj-field-modified
+ :help-echo help-text
+ :keymap widget-keymap
+ value)))
+ (widget-put widget ':prj-field field)
+ (if after-text
+ (widget-insert after-text))
+ (widget-insert "\n")
+ ))
+
+
+(provide 'ada-prj)
+;;; arch-tag: 65978c77-816e-49c6-896e-6905605d1b4c
+;;; ada-prj.el ends here