;;; ada-prj.el --- GUI editing of project files for the ada-mode
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: languages, ada, project file
+;; Package: ada-mode
;; 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 3, 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:
(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)
(ada-prj-new)))
-(defun ada-prj-initialize-values (symbol ada-buffer filename)
+(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 ""))
;; 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)
"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 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"
)
(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))
(widen)
(goto-char (point-min))
(while (not (eobp))
- (set 'line (buffer-substring-no-properties
- (point) (save-excursion (end-of-line) (point))))
+ (set 'line (buffer-substring-no-properties (point) (point-at-eol)))
(add-to-list 'list line)
- (forward-line 1)
- )
+ (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)
- ))
+ (reverse list)))))
+ (ada-prj-display-page 2)))
(defun ada-prj-subdirs-of (dir)
"Return a list of all the subdirectories of DIR, recursively."
;; 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 'file-name (read-directory-name "Root directory: " nil nil t))))
(set 'ada-prj-current-values
(plist-put ada-prj-current-values
(widget-insert "\n Project configuration.\n
___________ ____________ ____________ ____________ ____________\n / ")
(widget-create 'push-button :notify
- (lambda (&rest dummy) (ada-prj-display-page 1)) "General")
+ (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")
+ (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")
+ (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")
+ (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")
+ (lambda (&rest _dummy) (ada-prj-display-page 5)) "Debugger")
(widget-insert " \\\n")
;; Display the currently selected page
(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
"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.")
+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'.")
+vxworks, you would enter `powerpc-wrs-vxworks-'.
+To use JGNAT, enter `j'.")
)
((= 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)
+ :notify (lambda (&rest _ignore)
+ (setq ada-prj-current-values (ada-default-prj-properties))
(ada-prj-display-page 1))
"Reset to Default Values")
(widget-insert " ")
- (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil))
+ (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))
+ (widget-create 'push-button :notify (lambda (&rest _ignore) (ada-prj-save))
"Save")
(widget-insert "\n\n")
(ada-reread-prj-file ada-prj-default-project-file)
(ada-reread-prj-file)))
- ;; Else start the interactive editor
(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)
(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)
+ (use-local-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map custom-mode-map)
+ (define-key map "\C-x\C-s" 'ada-prj-save)
+ map))
- (make-local-variable 'widget-keymap)
- (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
+ ;; FIXME: Not sure if this works!!
+ (set (make-local-variable 'widget-keymap)
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map widget-keymap)
+ (define-key map "\C-x\C-s" 'ada-prj-save)
+ map))
(set (make-local-variable 'ada-old-cross-prefix)
(ada-xref-get-project-field 'cross-prefix))
ada-list "\n"))
-(defun ada-prj-field-modified (widget &rest dummy)
+(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
(widget-get widget ':prj-field)
(widget-value widget))))
-(defun ada-prj-display-help (widget widget-modified event)
+(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)))
;; variables
(momentary-string-display
(concat "*****Help*****\n" text "\n**************\n")
- (save-excursion (forward-line) (beginning-of-line) (point)))
- )))
+ (point-at-bol 2)))))
-(defun ada-prj-show-value (widget widget-modified event)
+(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))
"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
;;; ada-prj.el ends here