Mercurial > emacs
changeset 30410:01ac16657214
Rewritten to show a tabbed-dialog.
(ada-prj-add-ada-menu): Remove the map and name parameters.
(ada-prj-display-page, ada-prj-field, ada-prj-initialize-values):
New function
(ada-prj-load-directory, ada-prj-subdirs-of): New functions
(ada-prj-load-from-file): New function
(ada-prj-save): Always save fields that depend on the current buffer
(ada-prj-show-value): New function
| author | Gerd Moellmann <gerd@gnu.org> |
|---|---|
| date | Mon, 24 Jul 2000 11:14:01 +0000 |
| parents | a530830f8a3d |
| children | 41f228350eca |
| files | lisp/progmodes/ada-prj.el |
| diffstat | 1 files changed, 548 insertions(+), 366 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/ada-prj.el Mon Jul 24 11:13:40 2000 +0000 +++ b/lisp/progmodes/ada-prj.el Mon Jul 24 11:14:01 2000 +0000 @@ -1,9 +1,9 @@ ;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1998-1999 Free Software Foundation, Inc. ;; Author: Emmanuel Briot <briot@gnat.com> -;; Ada Core Technologies's version: $Revision: 1.30 $ +;; Ada Core Technologies's version: $Revision: 1.44 $ ;; Keywords: languages, ada, project file ;; This file is not part of GNU Emacs. @@ -22,14 +22,13 @@ ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, 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. ;; Code: @@ -38,103 +37,147 @@ (require 'cus-edit) +;; ----- Buffer local variables ------------------------------------------- -;; ----- 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)) +(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) -;; 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)) +(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) + +(defvar ada-prj-ada-buffer nil + "Indicates what Ada source file was being edited.") + + +;; ----- Functions -------------------------------------------------------- -(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)) +(defun ada-prj-new () + "Open a new project file" + (interactive) + (let* ((prj + (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)) + ada-prj-prj-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))) -;; ------ Functions ------------------------------------------------------- +(defun ada-prj-edit () + "Editing the project file associated with the current Ada buffer. +If there is none, opens a new project file" + (interactive) + (let ((file (ada-prj-find-prj-file))) + (if file + (progn + (ada-reread-prj-file file) + (ada-customize)) + (ada-prj-new)))) (defun ada-prj-add-ada-menu () - "Add a new submenu to the Ada menu." - (interactive) - + "Add a new submenu to the Ada menu. +The items are added to the menu NAME in map MAP. NAME should be the same +name as was passed to `ada-create-menu'." (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))) - )) + (funcall (symbol-function 'add-menu-button) + '("Ada" "Project") + ["Edit" ada-prj-edit t] "Associate") + (funcall (symbol-function 'add-menu-button) + '("Ada" "Project") + ["New..." ada-prj-new t] "Associate")) + (define-key (lookup-key ada-mode-map [menu-bar Ada Project]) + [Edit] '("Edit current" . ada-prj-edit)) + (define-key (lookup-key ada-mode-map [menu-bar Ada Project]) + [New] '("New" . ada-prj-new)))) (defun ada-prj-add-keymap () "Add new keybindings for ada-prj." - (define-key ada-mode-map "\C-cu" 'ada-customize)) + (define-key ada-mode-map "\C-cu" 'ada-prj-edit)) + +(defun ada-prj-initialize-values (symbol ada-buffer &optional 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." + + (let ((prj filename)) + + (if filename + ;; If filename is given, reread if first if needed + (if (file-exists-p filename) + (ada-reread-prj-file)) + + ;; Else use the one from the current buffer + (save-excursion + (set-buffer ada-buffer) + (set 'prj ada-prj-prj-file))) -(defun ada-customize (&optional new-file) - "Edit the project file associated with the current buffer. -If there is none or NEW-FILE is non-nil, make a new one." - (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))) + + (if (and prj + (not (string= prj "")) + (assoc prj ada-xref-project-files)) + (set symbol (copy-sequence (cdr (assoc prj 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 prj (not (string= prj ""))) + (set symbol (plist-put (eval symbol) 'filename prj))) + ))) + + +(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." + (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 currently 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 'cross_prefix) + (ada-prj-save-specific-option 'remote_machine) + (ada-prj-save-specific-option 'comp_cmd) + (ada-prj-save-specific-option 'check_cmd) + (ada-prj-save-specific-option 'make_cmd) + (ada-prj-save-specific-option 'run_cmd) + (ada-prj-save-specific-option 'debug_cmd) + + ;; Always save the fields that depend on the current buffer + (concat "main=" (plist-get ada-prj-current-values 'main) "\n") + (concat "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n") + (concat "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n") + + (ada-prj-set-list "casing" + (plist-get ada-prj-current-values 'casing)) "\n" + (ada-prj-set-list "src_dir" + (plist-get ada-prj-current-values 'src_dir)) "\n" + (ada-prj-set-list "obj_dir" + (plist-get ada-prj-current-values 'obj_dir)) "\n" + )) + (find-file file-name) (erase-buffer) (insert output) @@ -147,285 +190,306 @@ ;; automatically associates the current buffer with the ;; new project file - (make-local-variable 'ada-prj-prj-file) - (setq ada-prj-prj-file file-name) + (set (make-local-variable 'ada-prj-prj-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 associated with the current Ada buffer." - (let* ((old-name (buffer-file-name)) - prj-file) +(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) + "Returns 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 the content of FILE-NAME to FIELD in the current project file. +If FILE-NAME is nil, ask the user for the name." + (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 one of the pages available in the notebook. TAB-NUM should have +a value between 1 and the maximum number of pages. +The current buffer must be the project editing buffer." + + (let ((inhibit-read-only t)) + (erase-buffer)) + + ;; Display the tabs + + (widget-insert "\n Project and Editor 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 " \\\n") + + ;; Display the currently selected page + + (cond + + ;; + ;; First page (General) + ;; + ((= tab-num 1) + (widget-insert "_/ \\/______________\\/______________\\/______________\\_____\n\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'.") + ) - (unless old-name - (error - "No file name given for this buffer ! You need to open a file first")) + + ;; + ;; Second page (Paths) + ;; + ((= tab-num 2) + (widget-insert "_/_____________\\/ \\/______________\\/______________\\_____\n\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") - ;; Find the project file associated with the buffer - (setq prj-file (ada-prj-get-prj-dir old-name)) + (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\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.") + ) + ;; + ;; Fourth page + ;; + ((= tab-num 4) + (widget-insert "_/_____________\\/______________\\/______________\\/ \\_____\n\n") + (widget-insert "All the fields below can use variable substitution\n") + (widget-insert "The syntax is ${name}, where name is the name that\n") + (widget-insert "appears after the Help buttons in this buffer.\n") + (widget-insert "As a special case, ${current} is replaced with the name\n") + (widget-insert "of the file currently edited, with directory name but\n") + (widget-insert "no extension.\n\n") + (widget-insert + "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH\n") + (widget-insert + "are set to ${src_dir} and ${obj_dir} before running the compilation\n") + (widget-insert + "commands, so that you don't need to specify the -aI and -aO\n") + (widget-insert + "switches on the command line\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.") + (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.") + (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.") + (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.") + (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 + > gdbtk + > ddd --tty -fullname -toolbar") + ) + ) + + + (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) + (beginning-of-buffer) + ) + + +(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) + + (let ((ada-buffer (current-buffer)) + (inhibit-read-only t)) + + (ada-require-project-file) + (switch-to-buffer "*Customize Ada Mode*") (kill-all-local-variables) + + (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer) + (ada-prj-initialize-values 'ada-prj-current-values ada-buffer filename) - ;; 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)))) + (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) - (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") - - - ;; 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")) + (make-local-variable 'widget-keymap) + (define-key widget-keymap "\C-x\C-s" 'ada-prj-save) - (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") - - - ;; if it exists, kill the project file buffer - (if (and prj-file - (get-file-buffer prj-file)) - (kill-buffer (get-file-buffer prj-file))) - - (widget-setup) - (beginning-of-buffer) - ) - ) - + (ada-prj-display-page 1) + )) ;; ---------------- Utilities -------------------------------- -(defun ada-prj-new (variable prj-file text default message) - "Create a buffer-local variable with name VARIABLE. -If PRJ-FILE exists, read its value from that file, otherwise set it to -DEFAULT. -It also creates a widget in the current buffer to edit this variable, -which MESSAGE explaning what the variable is supposed to do. -TEXT is put just before the editable field, and should display the name -of the variable." - - ;; 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 with name VARIABLE. -If PRJ-FILE exists, read its value from that file, otherwise set it to -DEFAULT. -It also creates a widget in the current buffer to edit this variable, -which MESSAGE explaning what the variable is supposed to do. -TEXT is put just before the editable field, and should display the name -of the variable." - - ;; 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))) - -(defsubst ada-prj-set-list (string ada-dir-list) +(defun ada-prj-set-list (string ada-dir-list) "Join the strings in ADA-DIR-LIST into a single string. Each name is put on a separate line that begins with STRING." - (mapconcat (lambda (x) - (concat string "=" x - (unless (string= (substring x -1) "/") - "/"))) + (mapconcat (lambda (x) (concat string "=" (file-name-as-directory x))) ada-dir-list "\n")) + (defun ada-prj-get-prj-dir (&optional ada-file) "Returns the directory/name of the project file for ADA-FILE. If ADA-FILE is nil, returns the project file for the current buffer." @@ -434,31 +498,149 @@ (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) + )) + +(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." + (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." + (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) + (let ((value (plist-get ada-prj-current-values + (widget-get widget 'prj-field))) + (inhibit-read-only t)) + + ;; 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-default-value-set widget "Show Value") + ) + + ;; Else create it + (save-excursion + (mouse-set-point event) + (forward-line 1) + (beginning-of-line) + (widget-put widget 'prj-other-widget + (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-default-value-set widget "Hide Value") + ) + ) + (widget-setup) + )) - (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) - )) - ) +(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-field field) + (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") + )) -;; Initializations for the package -(add-hook 'ada-mode-hook 'ada-prj-add-ada-menu) - ;; 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) +(ada-prj-add-ada-menu) (provide 'ada-prj) ;;; package ada-prj.el ends here - - -