X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b35f288d478ef137a4d9e8e5a6a5f368a86b01f5..ab422c4d6899b1442cb6954c1829c1fb656b006c:/lisp/progmodes/ada-prj.el diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index daa1f2b9c6..f6125545b9 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -1,11 +1,11 @@ ;;; 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 ;; Maintainer: Stephen Leake ;; Keywords: languages, ada, project file +;; Package: ada-mode ;; This file is part of GNU Emacs. @@ -86,16 +86,16 @@ (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 "")) @@ -104,7 +104,7 @@ project file is found, returns the default values." ;; 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))) )) @@ -112,7 +112,7 @@ project file is found, returns the default values." (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)) "" @@ -122,7 +122,8 @@ If the current value of FIELD is the default value, returns an empty string." (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 @@ -141,7 +142,6 @@ If the current value of FIELD is the default value, returns an empty string." ;; 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" @@ -184,7 +184,8 @@ If the current value of FIELD is the default value, returns an empty string." ) (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)) @@ -194,21 +195,17 @@ If the current value of FIELD is the default value, returns an empty string." (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." @@ -230,7 +227,7 @@ If FILE-NAME is nil, ask the user for the name." ;; 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 @@ -260,19 +257,19 @@ The current buffer must be the project editing buffer." (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 @@ -288,26 +285,22 @@ The current buffer must be the project editing buffer." (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 @@ -401,7 +394,7 @@ ignored by gnatfind and you don't see the references within.") ((= 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 @@ -465,16 +458,15 @@ 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) + :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") @@ -513,21 +505,26 @@ If FILENAME is given, edit that file." (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)) @@ -549,7 +546,7 @@ converted to a directory name." 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 @@ -559,7 +556,7 @@ another page and coming back keeps the new value." (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))) @@ -573,10 +570,9 @@ Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." ;; 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)) @@ -617,9 +613,9 @@ Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." "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) @@ -686,5 +682,4 @@ AFTER-TEXT is inserted just after the widget." (provide 'ada-prj) -;; arch-tag: 65978c77-816e-49c6-896e-6905605d1b4c ;;; ada-prj.el ends here