;;; 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-2013 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.
(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
((= 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
HCoop / bpt / emacs.git / blobdiff