-;;; 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, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
+;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: languages, ada, project file
;; This file is part of GNU Emacs.
-;; GNU Emacs 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)
-;; any later version.
+;; 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
;; 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, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; 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:
;; ----- Functions --------------------------------------------------------
(defun ada-prj-new ()
- "Open a new project file"
+ "Open a new project file."
(interactive)
(let* ((prj
(if (and ada-prj-default-project-file
(defun ada-prj-edit ()
"Editing the project file associated with the current Ada buffer.
-If there is none, opens a new project file"
+If there is none, opens a new project file."
(interactive)
(if ada-prj-default-project-file
(ada-customize)
(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."
-
+If FILENAME is null, read the file associated with ADA-BUFFER.
+If no project file is found, return the default values."
+;; FIXME: rationalize arguments; make ada-buffer optional?
(if (and filename
(not (string= filename ""))
(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)
+ (set symbol (ada-default-prj-properties))
(if (and filename (not (string= filename "")))
(set symbol (plist-put (eval symbol) 'filename filename)))
))
(defun ada-prj-save-specific-option (field)
- "Returns 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."
+ "Return the string to print in the project file to save FIELD.
+If the current value of FIELD is the default value, return an empty string."
(if (string= (plist-get ada-prj-current-values field)
(plist-get ada-prj-default-values field))
""
(defun ada-prj-save ()
"Save the edited project file."
(interactive)
- (let ((file-name (plist-get ada-prj-current-values 'filename))
+ (let ((file-name (or (plist-get ada-prj-current-values 'filename)
+ (read-file-name "Save project as: ")))
output)
(set 'output
(concat
;; 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"
(kill-buffer nil)
;; kill the editor buffer
- (kill-buffer "*Customize Ada Mode*")
+ (kill-buffer "*Edit Ada Mode Project*")
;; automatically set the new project file as the active one
(set 'ada-prj-default-project-file file-name)
)
(defun ada-prj-load-from-file (symbol)
- "Load SYMBOL value from file. One item per line should be found in the file."
+ "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))
))
(defun ada-prj-subdirs-of (dir)
- "Returns a list of all the subdirectories of dir, recursively."
+ "Return a list of all the subdirectories of DIR, recursively."
(let ((subdirs (directory-files dir t "^[^.].*"))
(dirlist (list dir)))
(while subdirs
dirlist))
(defun ada-prj-load-directory (field &optional file-name)
- "Append the content of FILE-NAME to FIELD in the current project file.
+ "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
(ada-prj-display-page 2))
(defun ada-prj-display-page (tab-num)
- "Display one of the pages available in the notebook. TAB-NUM should have
-a value between 1 and the maximum number of pages.
+ "Display page TAB-NUM in the notebook.
The current buffer must be the project editing buffer."
(let ((inhibit-read-only t))
(progn
(setq widget-field-new nil
widget-field-list nil)
- (mapcar (lambda (x) (delete-overlay x)) (car (overlay-lists)))
- (mapcar (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
+ (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 and Editor configuration.\n
+ (widget-insert "\n Project configuration.\n
___________ ____________ ____________ ____________ ____________\n / ")
(widget-create 'push-button :notify
(lambda (&rest dummy) (ada-prj-display-page 1)) "General")
(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 'casing "Casing Exceptions"
+"List of files that contain casing exception
+dictionaries. All these files contain one
+identifier per line, with a special casing.
+The first file has the highest priority."
+ t nil
+ (mapconcat (lambda(x)
+ (concat " " x))
+ (ada-xref-get-project-field 'casing)
+ "\n")
+ )
(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
and the standard runtime."
t t
(mapconcat (lambda(x)
- (concat " " x))
- ada-xref-runtime-library-specs-path
- "\n")
+ (concat " " x))
+ ada-xref-runtime-library-specs-path
+ "\n")
)
(widget-insert "\n\n")
and the standard runtime."
t t
(mapconcat (lambda(x)
- (concat " " x))
- ada-xref-runtime-library-ali-path
- "\n")
+ (concat " " x))
+ ada-xref-runtime-library-ali-path
+ "\n")
)
(widget-insert "\n\n")
)
((= tab-num 4)
(widget-insert "/_____________\\/______________\\/______________\\/ \\/______________\\\n")
(widget-insert
-"All the fields below can use variable substitution The syntax is ${name},
+"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
(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)
+ (setq ada-prj-current-values (ada-default-prj-properties))
(ada-prj-display-page 1))
"Reset to Default Values")
(widget-insert " ")
(ada-reread-prj-file ada-prj-default-project-file)
(ada-reread-prj-file)))
- ;; Else start the interactive editor
- (switch-to-buffer "*Customize Ada Mode*")
+ (switch-to-buffer "*Edit Ada Mode Project*")
- (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)
;; ---------------- Utilities --------------------------------
(defun ada-prj-set-list (string ada-list &optional is-directory)
- "Join the strings in ADA-LIST into a single string.
-Each name is put on a separate line that begins with STRING.
-If IS-DIRECTORY is non-nil, each name is explicitly converted to a
-directory name."
+ "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"))
+ ada-list "\n"))
(defun ada-prj-field-modified (widget &rest dummy)
- "Callback called each time the value of WIDGET is modified. Save the
-change in ada-prj-current-values so that selecting another page and coming
-back keeps the new value."
+ "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)
- "An help button in WIDGET was clicked on. The parameters are so that
-this function can be used as :notify for the widget."
+ "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
)))
(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)
"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
+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,...
+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)
(provide 'ada-prj)
-;;; arch-tag: 65978c77-816e-49c6-896e-6905605d1b4c
+;; arch-tag: 65978c77-816e-49c6-896e-6905605d1b4c
;;; ada-prj.el ends here