aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGerd Moellmann2000-07-24 11:14:01 +0000
committerGerd Moellmann2000-07-24 11:14:01 +0000
commitc6fa13e32703f8b0634401778a758e76f2798f97 (patch)
treebb34d6f79b74bc7ea2f647d7347ff00022ba6273
parentcf543c1c14b17005af6780f221c985220a85aa7f (diff)
downloademacs-c6fa13e32703f8b0634401778a758e76f2798f97.tar.gz
emacs-c6fa13e32703f8b0634401778a758e76f2798f97.zip
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
-rw-r--r--lisp/progmodes/ada-prj.el916
1 files changed, 549 insertions, 367 deletions
diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el
index e23a3371155..7dc38e74e2a 100644
--- a/lisp/progmodes/ada-prj.el
+++ b/lisp/progmodes/ada-prj.el
@@ -1,9 +1,9 @@
1;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode 1;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode
2 2
3;; Copyright (C) 1998,1999 Free Software Foundation, Inc. 3;; Copyright (C) 1998-1999 Free Software Foundation, Inc.
4 4
5;; Author: Emmanuel Briot <briot@gnat.com> 5;; Author: Emmanuel Briot <briot@gnat.com>
6;; Ada Core Technologies's version: $Revision: 1.30 $ 6;; Ada Core Technologies's version: $Revision: 1.44 $
7;; Keywords: languages, ada, project file 7;; Keywords: languages, ada, project file
8 8
9;; This file is not part of GNU Emacs. 9;; This file is not part of GNU Emacs.
@@ -22,14 +22,13 @@
22;; along with GNU Emacs; see the file COPYING. If not, write to 22;; along with GNU Emacs; see the file COPYING. If not, write to
23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24 24
25;;; Commentary:
26;;; This package provides a set of functions to easily edit the project 25;;; This package provides a set of functions to easily edit the project
27;;; files used by the ada-mode. 26;;; files used by the ada-mode.
28;;; The only function publicly available here is `ada-prj-customize'. 27;;; The only function publicly available here is `ada-customize'.
29;;; Please ada-mode.el and its documentation for more information about the 28;;; See the documentation of the Ada mode for more information on the project
30;;; project files. 29;;; files.
31;;; 30;;; Internally, a project file is represented as a property list, with each
32;;; You need Emacs >= 20.2 to run this package 31;;; field of the project file matching one property of the list.
33 32
34;; Code: 33;; Code:
35 34
@@ -38,103 +37,147 @@
38 37
39(require 'cus-edit) 38(require 'cus-edit)
40 39
41
42;; ----- Buffer local variables ------------------------------------------- 40;; ----- Buffer local variables -------------------------------------------
43;; if non nil, then all the widgets will have the default values, instead
44;; of reading them from the project file
45(make-variable-buffer-local (defvar ada-prj-edit-use-default-values nil))
46
47;; List of the default values used for the field in the project file
48;; Mainly used to save only the modified fields into the file itself
49;; The values are hold in the properties of this variable
50(make-variable-buffer-local (defvar ada-prj-default nil))
51
52(make-variable-buffer-local (defvar ada-prj-widget-prj-dir nil))
53(make-variable-buffer-local (defvar ada-prj-widget-src-dir nil))
54(make-variable-buffer-local (defvar ada-prj-widget-obj-dir nil))
55(make-variable-buffer-local (defvar ada-prj-widget-main nil))
56(make-variable-buffer-local (defvar ada-prj-widget-comp-opt nil))
57(make-variable-buffer-local (defvar ada-prj-widget-bind-opt nil))
58(make-variable-buffer-local (defvar ada-prj-widget-link-opt nil))
59(make-variable-buffer-local (defvar ada-prj-widget-remote-machine nil))
60(make-variable-buffer-local (defvar ada-prj-widget-comp-cmd nil))
61(make-variable-buffer-local (defvar ada-prj-widget-make-cmd nil))
62(make-variable-buffer-local (defvar ada-prj-widget-run-cmd nil))
63(make-variable-buffer-local (defvar ada-prj-widget-debug-cmd nil))
64(make-variable-buffer-local (defvar ada-prj-widget-cross-prefix nil))
65
66;; ------ Functions -------------------------------------------------------
67 41
68(defun ada-prj-add-ada-menu () 42(defvar ada-prj-current-values nil
69 "Add a new submenu to the Ada menu." 43 "Hold the current value of the fields, This is a property list.")
44(make-variable-buffer-local 'ada-prj-current-values)
45
46(defvar ada-prj-default-values nil
47 "Hold the default value for the fields, This is a property list.")
48(make-variable-buffer-local 'ada-prj-default-values)
49
50(defvar ada-prj-ada-buffer nil
51 "Indicates what Ada source file was being edited.")
52
53
54;; ----- Functions --------------------------------------------------------
55
56(defun ada-prj-new ()
57 "Open a new project file"
70 (interactive) 58 (interactive)
59 (let* ((prj
60 (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
61 ada-prj-prj-file
62 "default.adp"))
63 (filename (read-file-name "Project file: "
64 (if prj "" nil)
65 nil
66 nil
67 prj)))
68 (if (not (string= (file-name-extension filename t) ".adp"))
69 (error "File name extension for project files must be .adp"))
70
71 (ada-customize nil filename)))
72
73(defun ada-prj-edit ()
74 "Editing the project file associated with the current Ada buffer.
75If there is none, opens a new project file"
76 (interactive)
77 (let ((file (ada-prj-find-prj-file)))
78 (if file
79 (progn
80 (ada-reread-prj-file file)
81 (ada-customize))
82 (ada-prj-new))))
71 83
84(defun ada-prj-add-ada-menu ()
85 "Add a new submenu to the Ada menu.
86The items are added to the menu NAME in map MAP. NAME should be the same
87name as was passed to `ada-create-menu'."
72 (if ada-xemacs 88 (if ada-xemacs
73 (progn 89 (progn
74 (add-menu-button '("Ada" "Project") ["New/Edit" ada-customize t] "Associate") 90 (funcall (symbol-function 'add-menu-button)
75 ) 91 '("Ada" "Project")
76 (let ((prj-menu (lookup-key ada-mode-map [menu-bar Ada Project]))) 92 ["Edit" ada-prj-edit t] "Associate")
77 (define-key prj-menu [New] '("New/Edit" . ada-customize))) 93 (funcall (symbol-function 'add-menu-button)
78 )) 94 '("Ada" "Project")
95 ["New..." ada-prj-new t] "Associate"))
96 (define-key (lookup-key ada-mode-map [menu-bar Ada Project])
97 [Edit] '("Edit current" . ada-prj-edit))
98 (define-key (lookup-key ada-mode-map [menu-bar Ada Project])
99 [New] '("New" . ada-prj-new))))
79 100
80(defun ada-prj-add-keymap () 101(defun ada-prj-add-keymap ()
81 "Add new keybindings for ada-prj." 102 "Add new keybindings for ada-prj."
82 (define-key ada-mode-map "\C-cu" 'ada-customize)) 103 (define-key ada-mode-map "\C-cu" 'ada-prj-edit))
104
105(defun ada-prj-initialize-values (symbol ada-buffer &optional filename)
106 "Set SYMBOL to the property list of the project file FILENAME.
107If FILENAME is null, read the file associated with ADA-BUFFER. If no
108project file is found, returns the default values."
109
110 (let ((prj filename))
111
112 (if filename
113 ;; If filename is given, reread if first if needed
114 (if (file-exists-p filename)
115 (ada-reread-prj-file))
116
117 ;; Else use the one from the current buffer
118 (save-excursion
119 (set-buffer ada-buffer)
120 (set 'prj ada-prj-prj-file)))
121
122
123 (if (and prj
124 (not (string= prj ""))
125 (assoc prj ada-xref-project-files))
126 (set symbol (copy-sequence (cdr (assoc prj ada-xref-project-files))))
127
128 ;; Set default values (except for the file name if this was given
129 ;; in the buffer
130 (ada-xref-set-default-prj-values symbol ada-buffer)
131 (if (and prj (not (string= prj "")))
132 (set symbol (plist-put (eval symbol) 'filename prj)))
133 )))
134
83 135
84(defun ada-customize (&optional new-file) 136(defun ada-prj-save-specific-option (field)
85 "Edit the project file associated with the current buffer. 137 "Returns the string to print in the project file to save FIELD.
86If there is none or NEW-FILE is non-nil, make a new one." 138If the current value of FIELD is the default value, returns an empty string."
87 (interactive) 139 (if (string= (plist-get ada-prj-current-values field)
88 (if new-file 140 (plist-get ada-prj-default-values field))
89 (progn 141 ""
90 (setq ada-prj-edit-use-default-values t) 142 (concat (symbol-name field)
91 (kill-local-variable 'ada-prj-prj-file) 143 "=" (plist-get ada-prj-current-values field) "\n")))
92 (ada-prj-customize)
93 (setq ada-prj-edit-use-default-values nil))
94 (ada-prj-customize)))
95 144
96(defun ada-prj-save () 145(defun ada-prj-save ()
97 "Save the currently edited project file." 146 "Save the edited project file."
98 (interactive) 147 (interactive)
99 (let ((file-name (widget-value ada-prj-widget-prj-dir)) 148 (let ((file-name (plist-get ada-prj-current-values 'filename))
100 value output) 149 output)
101 (setq output 150 (set 'output
102 (concat 151 (concat
103 (ada-prj-set-list "src_dir" (widget-value ada-prj-widget-src-dir)) 152
104 "\n" 153 ;; Save the fields that do not depend on the current buffer
105 (ada-prj-set-list "obj_dir" (widget-value ada-prj-widget-obj-dir)) 154 ;; only if they are different from the default value
106 "\n" 155
107 (unless (string= (setq value (widget-value ada-prj-widget-comp-opt)) 156 (ada-prj-save-specific-option 'comp_opt)
108 (get 'ada-prj-default 'comp_opt)) 157 (ada-prj-save-specific-option 'bind_opt)
109 (concat "comp_opt=" value "\n")) 158 (ada-prj-save-specific-option 'link_opt)
110 (unless (string= (setq value (widget-value ada-prj-widget-bind-opt)) 159 (ada-prj-save-specific-option 'gnatmake_opt)
111 (get 'ada-prj-default 'bind_opt)) 160 (ada-prj-save-specific-option 'cross_prefix)
112 (concat "bind_opt=" value "\n")) 161 (ada-prj-save-specific-option 'remote_machine)
113 (unless (string= (setq value (widget-value ada-prj-widget-link-opt)) 162 (ada-prj-save-specific-option 'comp_cmd)
114 (get 'ada-prj-default 'link_opt)) 163 (ada-prj-save-specific-option 'check_cmd)
115 (concat "link_opt=" value "\n")) 164 (ada-prj-save-specific-option 'make_cmd)
116 (unless (string= (setq value (widget-value ada-prj-widget-main)) 165 (ada-prj-save-specific-option 'run_cmd)
117 (get 'ada-prj-default 'main)) 166 (ada-prj-save-specific-option 'debug_cmd)
118 (concat "main=" value "\n")) 167
119 (unless (string= (setq value (widget-value ada-prj-widget-cross-prefix)) 168 ;; Always save the fields that depend on the current buffer
120 (get 'ada-prj-default 'cross-prefix)) 169 (concat "main=" (plist-get ada-prj-current-values 'main) "\n")
121 (concat "cross_prefix=" value "\n")) 170 (concat "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n")
122 (unless (string= (setq value (widget-value ada-prj-widget-remote-machine)) 171 (concat "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n")
123 (get 'ada-prj-default 'remote-machine)) 172
124 (concat "remote_machine=" value "\n")) 173 (ada-prj-set-list "casing"
125 (unless (string= (setq value (widget-value ada-prj-widget-comp-cmd)) 174 (plist-get ada-prj-current-values 'casing)) "\n"
126 (get 'ada-prj-default 'comp_cmd)) 175 (ada-prj-set-list "src_dir"
127 (concat "comp_cmd=" value "\n")) 176 (plist-get ada-prj-current-values 'src_dir)) "\n"
128 (unless (string= (setq value (widget-value ada-prj-widget-make-cmd)) 177 (ada-prj-set-list "obj_dir"
129 (get 'ada-prj-default 'make_cmd)) 178 (plist-get ada-prj-current-values 'obj_dir)) "\n"
130 (concat "make_cmd=" value "\n")) 179 ))
131 (unless (string= (setq value (widget-value ada-prj-widget-run-cmd)) 180
132 (get 'ada-prj-default 'run_cmd))
133 (concat "run_cmd=" value "\n"))
134 (unless (string= (setq value (widget-value ada-prj-widget-debug-cmd))
135 (get 'ada-prj-default 'debug_cmd))
136 (concat "debug_cmd=" value "\n"))
137 ))
138 (find-file file-name) 181 (find-file file-name)
139 (erase-buffer) 182 (erase-buffer)
140 (insert output) 183 (insert output)
@@ -147,285 +190,306 @@ If there is none or NEW-FILE is non-nil, make a new one."
147 190
148 ;; automatically associates the current buffer with the 191 ;; automatically associates the current buffer with the
149 ;; new project file 192 ;; new project file
150 (make-local-variable 'ada-prj-prj-file) 193 (set (make-local-variable 'ada-prj-prj-file) file-name)
151 (setq ada-prj-prj-file file-name)
152 194
153 ;; force emacs to reread the project files 195 ;; force Emacs to reread the project files
154 (ada-reread-prj-file t) 196 (ada-reread-prj-file file-name)
155 ) 197 )
156 ) 198 )
157 199
158(defun ada-prj-customize () 200(defun ada-prj-load-from-file (symbol)
159 "Edit the project file associated with the current Ada buffer." 201 "Load SYMBOL value from file. One item per line should be found in the file."
160 (let* ((old-name (buffer-file-name)) 202 (save-excursion
161 prj-file) 203 (let ((file (read-file-name "File name: " nil nil t))
204 (buffer (current-buffer))
205 line
206 list)
207 (find-file file)
208 (widen)
209 (goto-char (point-min))
210 (while (not (eobp))
211 (set 'line (buffer-substring-no-properties
212 (point) (save-excursion (end-of-line) (point))))
213 (add-to-list 'list line)
214 (forward-line 1)
215 )
216 (kill-buffer nil)
217 (set-buffer buffer)
218 (set 'ada-prj-current-values
219 (plist-put ada-prj-current-values
220 symbol
221 (append (plist-get ada-prj-current-values symbol)
222 (reverse list))))
223 )
224 (ada-prj-display-page 2)
225 ))
226
227(defun ada-prj-subdirs-of (dir)
228 "Returns a list of all the subdirectories of dir, recursively."
229 (let ((subdirs (directory-files dir t "^[^.].*"))
230 (dirlist (list dir)))
231 (while subdirs
232 (if (file-directory-p (car subdirs))
233 (let ((sub (ada-prj-subdirs-of (car subdirs))))
234 (if sub
235 (set 'dirlist (append sub dirlist)))))
236 (set 'subdirs (cdr subdirs)))
237 dirlist))
238
239(defun ada-prj-load-directory (field &optional file-name)
240 "Append the content of FILE-NAME to FIELD in the current project file.
241If FILE-NAME is nil, ask the user for the name."
242 (unless file-name
243 (set 'file-name (read-file-name "Root directory: " nil nil t)))
244
245 (set 'ada-prj-current-values
246 (plist-put ada-prj-current-values
247 field
248 (append (plist-get ada-prj-current-values field)
249 (reverse (ada-prj-subdirs-of
250 (expand-file-name file-name))))))
251 (ada-prj-display-page 2))
252
253(defun ada-prj-display-page (tab-num)
254 "Display one of the pages available in the notebook. TAB-NUM should have
255a value between 1 and the maximum number of pages.
256The current buffer must be the project editing buffer."
257
258 (let ((inhibit-read-only t))
259 (erase-buffer))
260
261 ;; Display the tabs
262
263 (widget-insert "\n Project and Editor configuration.\n
264 ___________ ____________ ____________ ____________\n / ")
265 (widget-create 'push-button :notify
266 (lambda (&rest dummy) (ada-prj-display-page 1)) "General")
267 (widget-insert " \\ / ")
268 (widget-create 'push-button :notify
269 (lambda (&rest dummy) (ada-prj-display-page 2)) "Paths")
270 (widget-insert " \\ / ")
271 (widget-create 'push-button :notify
272 (lambda (&rest dummy) (ada-prj-display-page 3)) "Switches")
273 (widget-insert " \\ / ")
274 (widget-create 'push-button :notify
275 (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu")
276 (widget-insert " \\\n")
277
278 ;; Display the currently selected page
279
280 (cond
281
282 ;;
283 ;; First page (General)
284 ;;
285 ((= tab-num 1)
286 (widget-insert "_/ \\/______________\\/______________\\/______________\\_____\n\n")
287
288 (widget-insert "Project file name:\n")
289 (widget-insert (plist-get ada-prj-current-values 'filename))
290 (widget-insert "\n\n")
291; (ada-prj-field 'filename "Project file name"
292; "Enter the name and directory of the project
293; file. The name of the file should be the
294; name of the project itself. The extension
295; must be .adp")
296; (ada-prj-field 'casing "Casing Exceptions Dictionnaries"
297; "List of files that contain casing exception
298; dictionnaries. All these files contain one
299; identifier per line, with a special casing.
300; The first file has the highest priority."
301; t)
302 (ada-prj-field 'main "Executable file name"
303"Name of the executable generated when you
304compile your application. This should include
305the full directory name, using ${build_dir} if
306you wish.")
307 (ada-prj-field 'main_unit "File name of the main unit"
308"Name of the file to pass to the gnatmake command,
309and that will create the executable.
310This should not include any directory specification.")
311 (ada-prj-field 'build_dir "Build directory"
312 "Reference directory for relative paths in
313src_dir and obj_dir below. This is also the directory
314where the compilation is done.")
315 (ada-prj-field 'remote_machine "Name of the remote machine (if any)"
316"If you want to remotely compile, debug and
317run your application, specify the name of a
318remote machine here. This capability requires
319the 'rsh' protocol on the remote machine.")
320 (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain"
321"When working on multiple cross targets, it is
322most convenient to specify the prefix of the
323tool chain here. For instance, on PowerPc
324vxworks, you would enter 'powerpc-wrs-vxworks-'.
325To use JGNAT, enter 'j'.")
326 )
162 327
163 (unless old-name 328
164 (error 329 ;;
165 "No file name given for this buffer ! You need to open a file first")) 330 ;; Second page (Paths)
331 ;;
332 ((= tab-num 2)
333 (widget-insert "_/_____________\\/ \\/______________\\/______________\\_____\n\n")
334 (ada-prj-field 'src_dir "Source directories"
335"Enter the list of directories where your Ada
336sources can be found. These directories will be
337used for the cross-references and for the default
338compilation commands.
339Note that src_dir includes both the build directory
340and the standard runtime."
341 t t
342 (mapconcat (lambda(x)
343 (concat " " x))
344 ada-xref-runtime-library-specs-path
345 "\n")
346 )
347 (widget-insert "\n\n")
166 348
167 ;; Find the project file associated with the buffer 349 (ada-prj-field 'obj_dir "Object directories"
168 (setq prj-file (ada-prj-get-prj-dir old-name)) 350"Enter the list of directories where the GNAT
351library files (ALI files) can be found. These
352files are used for cross-references and by the
353gnatmake command.
354Note that obj_dir includes both the build directory
355and the standard runtime."
356 t t
357 (mapconcat (lambda(x)
358 (concat " " x))
359 ada-xref-runtime-library-ali-path
360 "\n")
361 )
362 (widget-insert "\n\n")
363 )
169 364
170 (switch-to-buffer "*Customize Ada Mode*") 365 ;;
171 (kill-all-local-variables) 366 ;; Third page (Switches)
367 ;;
368 ((= tab-num 3)
369 (widget-insert "_/_____________\\/______________\\/ \\/______________\\_____\n\n")
370 (ada-prj-field 'comp_opt "Switches for the compiler"
371"These switches are used in the default
372compilation commands, both for compiling a
373single file and rebuilding the whole project")
374 (ada-prj-field 'bind_opt "Switches for the binder"
375"These switches are used in the default build
376command and are passed to the binder")
377 (ada-prj-field 'link_opt "Switches for the linker"
378"These switches are used in the default build
379command and are passed to the linker")
380 (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
381"These switches are used in the default gnatmake
382command.")
383 )
172 384
173 ;; Find the default values 385 ;;
174 (setq ada-prj-default nil) 386 ;; Fourth page
175 (put 'ada-prj-default 'src_dir (list (file-name-directory old-name))) 387 ;;
176 (put 'ada-prj-default 'obj_dir (list (file-name-directory old-name))) 388 ((= tab-num 4)
177 (put 'ada-prj-default 'comp_opt "") 389 (widget-insert "_/_____________\\/______________\\/______________\\/ \\_____\n\n")
178 (put 'ada-prj-default 'bind_opt "") 390 (widget-insert "All the fields below can use variable substitution\n")
179 (put 'ada-prj-default 'link_opt "") 391 (widget-insert "The syntax is ${name}, where name is the name that\n")
180 (put 'ada-prj-default 'main "") 392 (widget-insert "appears after the Help buttons in this buffer.\n")
181 (put 'ada-prj-default 'cross_prefix "") 393 (widget-insert "As a special case, ${current} is replaced with the name\n")
182 (put 'ada-prj-default 'remote_machine "") 394 (widget-insert "of the file currently edited, with directory name but\n")
183 (put 'ada-prj-default 'comp_cmd 395 (widget-insert "no extension.\n\n")
184 (concat "cd " (file-name-directory old-name) " && " 396 (widget-insert
185 ada-prj-default-comp-cmd)) 397 "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH\n")
186 (put 'ada-prj-default 'make_cmd 398 (widget-insert
187 (concat "cd " (file-name-directory old-name) " && " 399 "are set to ${src_dir} and ${obj_dir} before running the compilation\n")
188 ada-prj-default-make-cmd)) 400 (widget-insert
189 (put 'ada-prj-default 'run_cmd (if is-windows "${main}.exe" "${main}")) 401 "commands, so that you don't need to specify the -aI and -aO\n")
190 (put 'ada-prj-default 'debug_cmd 402 (widget-insert
191 (if is-windows "${cross_prefix}gdb ${main}.exe" 403 "switches on the command line\n\n")
192 "${cross_prefix}gdb ${main}")) 404
193 405 (ada-prj-field 'check_cmd
194 (let ((inhibit-read-only t)) 406 "Check syntax of a single file (menu Ada->Check File)"
195 (erase-buffer)) 407"This command is run to check the syntax and semantics of a file.
196 408The file name is added at the end of this command.")
197 ;;; Overlay-lists is not defined on XEmacs 409 (ada-prj-field 'comp_cmd
198 (if (fboundp 'overlay-lists) 410 "Compiling a single file (menu Ada->Compile File)"
199 (let ((all (overlay-lists))) 411"This command is run when the recompilation
200 ;; Delete all the overlays. 412of a single file is needed. The file name is
201 (mapcar 'delete-overlay (car all)) 413added at the end of this command.")
202 (mapcar 'delete-overlay (cdr all)))) 414 (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)"
415"This command is run when you want to rebuild
416your whole application. It is never issues
417automatically and you will need to ask for it.
418If remote_machine has been set, this command
419will be executed on the remote machine.")
420 (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)"
421"This command specifies how to run the
422application, including any switch you need to
423specify. If remote_machine has been set, this
424command will be executed on the remote host.")
425 (ada-prj-field 'debug_cmd "Debugging the application"
426"Specifies how to debug the application, possibly
427remotely if remote_machine has been set. We
428recommend the following debuggers:
429 > gdb
430 > gdbtk
431 > ddd --tty -fullname -toolbar")
432 )
433 )
434
435
436 (widget-insert "______________________________________________________________________\n\n ")
437 (widget-create 'push-button
438 :notify (lambda (&rest ignore)
439 (ada-xref-set-default-prj-values
440 'ada-prj-current-values ada-prj-ada-buffer)
441 (ada-prj-display-page 1))
442 "Reset to Default Values")
443 (widget-insert " ")
444 (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil))
445 "Cancel")
446 (widget-insert " ")
447 (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save))
448 "Save")
449 (widget-insert "\n\n")
450
451 (widget-setup)
452 (beginning-of-buffer)
453 )
203 454
204 (use-local-map (copy-keymap custom-mode-map))
205 (local-set-key "\C-x\C-s" 'ada-prj-save)
206 455
207 (widget-insert " 456(defun ada-customize (&optional new-file filename)
208---------------------------------------------------------------- 457 "Edit the project file associated with the current buffer.
209-- Customize your Emacs Ada mode for the current application -- 458If there is none or NEW-FILE is non-nil, make a new one.
210---------------------------------------------------------------- 459If FILENAME is given, edit that file."
211This buffer will allow you to create easily a project file for your application. 460 (interactive)
212This file will tell Emacs where to find the ada sources, the cross-referencing
213informations, how to compile and run your application, ...
214
215Please use the RETURN key, or middle mouse button to activate the fields.\n\n")
216
217 ;; Reset Button
218 (widget-create 'push-button
219 :notify (lambda (&rest ignore)
220 (setq ada-prj-edit-use-default-values t)
221 (kill-buffer nil)
222 (ada-prj-customize)
223 (setq ada-prj-edit-use-default-values nil)
224 )
225 "Reset to Default Values")
226 (widget-insert "\n")
227 461
462 (let ((ada-buffer (current-buffer))
463 (inhibit-read-only t))
228 464
229 ;; Create local variables with their initial value 465 (ada-require-project-file)
230 (setq ada-prj-widget-prj-dir 466
231 (ada-prj-new 'ada-prj-widget-prj-dir nil "" prj-file 467 (switch-to-buffer "*Customize Ada Mode*")
232 "\nName and directory of the project file. 468 (kill-all-local-variables)
233Put a new name here if you want to create a new project file\n")) 469
234 470 (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
235 (setq ada-prj-widget-src-dir 471 (ada-prj-initialize-values 'ada-prj-current-values ada-buffer filename)
236 (ada-prj-list 'ada-prj-widget-src-dir prj-file "src_dir"
237 (get 'ada-prj-default 'src_dir)
238 "\nYou should enter below all the directories where Emacs
239will find your ada sources for the current application\n"))
240
241 (setq ada-prj-widget-obj-dir
242 (ada-prj-list 'ada-prj-widget-obj-dir prj-file "obj_dir"
243 (get 'ada-prj-default 'obj_dir)
244 "\nBelow are the directories where the object files generated
245by the compiler will be found. This files are required for the cross-referencing
246capabilities of the Emacs' Ada-mode.\n"))
247
248 (setq ada-prj-widget-comp-opt
249 (ada-prj-new 'ada-prj-widget-comp-opt prj-file "comp_opt"
250 (get 'ada-prj-default 'comp_opt)
251 "\nPut below the compiler switches.\n"))
252
253 (setq ada-prj-widget-bind-opt
254 (ada-prj-new 'ada-prj-widget-bind-opt prj-file "bind_opt"
255 (get 'ada-prj-default 'bind_opt)
256 "\nPut below the binder switches.\n"))
257
258 (setq ada-prj-widget-link-opt
259 (ada-prj-new 'ada-prj-widget-link-opt prj-file "link_opt"
260 (get 'ada-prj-default 'link_opt)
261 "\nPut below the linker switches.\n"))
262
263 (setq ada-prj-widget-main
264 (ada-prj-new 'ada-prj-widget-main prj-file "main"
265 (file-name-sans-extension old-name)
266 "\nPut below the name of the main program for your application\n"))
267
268 (setq ada-prj-widget-cross-prefix
269 (ada-prj-new 'ada-prj-widget-cross-prefix prj-file "cross_prefix"
270 (get 'ada-prj-default 'cross_prefix)
271 "\nIf you are using a cross compiler, you might want to
272set the following variable so that the correct compiler is used by default\n"))
273
274 (setq ada-prj-widget-remote-machine
275 (ada-prj-new 'ada-prj-widget-remote-machine prj-file "remote_machine"
276 (get 'ada-prj-default 'remote_machine)
277 "\nName of the machine to log on before a compilation.
278Leave an empty field if you want to compile on the local machine.
279This will not work on Windows NT, since we only do a 'rsh' to the
280remote machine and then issue the command. \n"))
281
282 (widget-insert "\n
283-------------------------------------------------------------------------------
284 / \\ !! Advanced Users !! : For the following commands, you may use
285 / | \\ a somewhat more complicated syntax to describe them. If you
286 / | \\ use some special fields, they will be replaced at run-time by
287 / | \\ the variables defined above.
288 / | \\ These special fields are : ${remote_machine}
289 / o \\ -aI${src_dir} -I${src_dir} -aO${obj_dir} ${comp_opt}
290 ------------- ${bind_opt} ${link_opt} ${main} ${cross_prefix}
291
292The easiest way is to ignore this possibility. These fields are intended only
293for user who really understand what `variable substitution' means.
294-------------------------------------------------------------------------------\n")
295
296 (setq ada-prj-widget-comp-cmd
297 (ada-prj-new 'ada-prj-widget-comp-cmd prj-file "comp_cmd"
298 (get 'ada-prj-default 'comp_cmd)
299 "\nPut below the command used to compile ONE file.
300The name of the file to compile will be added at the end of the command.
301This command will also be used to check the file.\n"))
302
303 (setq ada-prj-widget-make-cmd
304 (ada-prj-new 'ada-prj-widget-make-cmd prj-file "make_cmd"
305 (get 'ada-prj-default 'make_cmd)
306 "\nPut below the command used to compile the whole application.\n"))
307
308 (setq ada-prj-widget-run-cmd
309 (ada-prj-new 'ada-prj-widget-run-cmd prj-file "run_cmd"
310 (get 'ada-prj-default 'run_cmd)
311 "\nPut below the command used to run your application.\n"))
312
313 (setq ada-prj-widget-debug-cmd
314 (ada-prj-new 'ada-prj-widget-run-cmd prj-file "debug_cmd"
315 (get 'ada-prj-default 'debug_cmd)
316 "\nPut below the command used to launch the debugger on your application.\n"))
317
318 ;; the two buttons to validate or cancel the modification
319 (widget-insert "\nWhen you have finish completing the above fields, choose one of the two buttons
320below, to validate or cancel your modifications.
321If you choose `OK', your settings will be saved to the file whose name is given above.\n")
322
323 (widget-create 'push-button
324 :notify (lambda (&rest ignore) (ada-prj-save))
325 "OK")
326
327 (widget-insert " ")
328 (widget-create 'push-button
329 :notify (lambda (&rest ignore)
330 (kill-buffer nil))
331 "Cancel")
332 (widget-insert "\n")
333 472
473 (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
334 474
335 ;; if it exists, kill the project file buffer 475 (use-local-map (copy-keymap custom-mode-map))
336 (if (and prj-file 476 (local-set-key "\C-x\C-s" 'ada-prj-save)
337 (get-file-buffer prj-file))
338 (kill-buffer (get-file-buffer prj-file)))
339 477
340 (widget-setup) 478 (make-local-variable 'widget-keymap)
341 (beginning-of-buffer) 479 (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
342 )
343 )
344 480
481 (ada-prj-display-page 1)
482 ))
345 483
346;; ---------------- Utilities -------------------------------- 484;; ---------------- Utilities --------------------------------
347 485
348(defun ada-prj-new (variable prj-file text default message) 486(defun ada-prj-set-list (string ada-dir-list)
349 "Create a buffer-local variable with name VARIABLE.
350If PRJ-FILE exists, read its value from that file, otherwise set it to
351DEFAULT.
352It also creates a widget in the current buffer to edit this variable,
353which MESSAGE explaning what the variable is supposed to do.
354TEXT is put just before the editable field, and should display the name
355of the variable."
356
357 ;; create local variable
358 (make-local-variable variable)
359 (let ((value default)
360 (regexp (concat "^" text "=\\(.*\\)")))
361 ;; if the project file exists
362 (if (and prj-file (not ada-prj-edit-use-default-values)
363 (file-readable-p prj-file))
364 ;; find the value
365 (save-excursion
366 (find-file prj-file)
367 (beginning-of-buffer)
368 (if (re-search-forward regexp nil t)
369 (setq value (match-string 1)))
370 ))
371 ;; assign a new value to the variable
372 (setq variable value))
373
374 (widget-insert message)
375
376 (widget-create 'editable-field
377 :format (if (string= text "") "%v"
378 (concat text "= %v"))
379 :keymap widget-keymap
380 variable))
381
382
383(defun ada-prj-list (variable prj-file text default message)
384 "Create a buffer-local list variable with name VARIABLE.
385If PRJ-FILE exists, read its value from that file, otherwise set it to
386DEFAULT.
387It also creates a widget in the current buffer to edit this variable,
388which MESSAGE explaning what the variable is supposed to do.
389TEXT is put just before the editable field, and should display the name
390of the variable."
391
392 ;; create local variable
393 (make-local-variable variable)
394 (let ((value nil)
395 (regexp (concat "^" text "=\\(.*\\)")))
396 ;; if the project file exists
397 (if (and prj-file (not ada-prj-edit-use-default-values)
398 (file-readable-p prj-file))
399 ;; find the value
400 (save-excursion
401 (find-file prj-file)
402 (goto-char (point-min))
403 ;; for each line, add its value
404 (while
405 (re-search-forward regexp nil t)
406 (progn
407 (setq value (cons (match-string 1) value)))
408 )))
409
410 ;; assign a new value to the variable
411 (setq variable
412 (if value (reverse value) default)))
413
414 (widget-insert message)
415 (widget-create 'editable-list
416 :entry-format (concat text "= %i %d %v")
417 :value variable
418 (list 'editable-field :keymap widget-keymap)))
419
420(defsubst ada-prj-set-list (string ada-dir-list)
421 "Join the strings in ADA-DIR-LIST into a single string. Each name is put 487 "Join the strings in ADA-DIR-LIST into a single string. Each name is put
422on a separate line that begins with STRING." 488on a separate line that begins with STRING."
423 (mapconcat (lambda (x) 489 (mapconcat (lambda (x) (concat string "=" (file-name-as-directory x)))
424 (concat string "=" x
425 (unless (string= (substring x -1) "/")
426 "/")))
427 ada-dir-list "\n")) 490 ada-dir-list "\n"))
428 491
492
429(defun ada-prj-get-prj-dir (&optional ada-file) 493(defun ada-prj-get-prj-dir (&optional ada-file)
430 "Returns the directory/name of the project file for ADA-FILE. 494 "Returns the directory/name of the project file for ADA-FILE.
431If ADA-FILE is nil, returns the project file for the current buffer." 495If ADA-FILE is nil, returns the project file for the current buffer."
@@ -434,31 +498,149 @@ If ADA-FILE is nil, returns the project file for the current buffer."
434 498
435 (save-excursion 499 (save-excursion
436 (set-buffer (get-file-buffer ada-file)) 500 (set-buffer (get-file-buffer ada-file))
437 (if ada-prj-edit-use-default-values 501
438 (concat (file-name-sans-extension ada-file) 502 (let ((prj-file (ada-prj-find-prj-file t)))
439 ada-project-file-extension) 503 (if (or (not prj-file)
440 504 (not (file-exists-p prj-file))
441 (let ((prj-file (ada-prj-find-prj-file t))) 505 )
442 (if (or (not prj-file) 506 (setq prj-file
443 (not (file-exists-p prj-file)) 507 (concat (file-name-sans-extension ada-file)
444 ) 508 ada-project-file-extension)))
445 (setq prj-file 509 prj-file)
446 (concat (file-name-sans-extension ada-file) 510 ))
447 ada-project-file-extension)))
448 prj-file)
449 ))
450 )
451 511
512(defun ada-prj-field-modified (widget &rest dummy)
513 "Callback called each time the value of WIDGET is modified. Save the
514change in ada-prj-current-values so that selecting another page and coming
515back keeps the new value."
516 (set 'ada-prj-current-values
517 (plist-put ada-prj-current-values
518 (widget-get widget 'prj-field)
519 (widget-value widget))))
520
521(defun ada-prj-display-help (widget widget-modified event)
522 "An help button in WIDGET was clicked on. The parameters are so that
523this function can be used as :notify for the widget."
524 (let ((text (widget-get widget 'prj-help)))
525 (if event
526 ;; If we have a mouse-event, popup a menu
527 (widget-choose "Help"
528 (mapcar (lambda (a) (cons a t))
529 (split-string text "\n"))
530 event)
531 ;; Else display the help string just before the next group of
532 ;; variables
533 (momentary-string-display
534 (concat "*****Help*****\n" text "\n**************\n")
535 (save-excursion (forward-line) (beginning-of-line) (point)))
536 )))
537
538(defun ada-prj-show-value (widget widget-modified event)
539 (let ((value (plist-get ada-prj-current-values
540 (widget-get widget 'prj-field)))
541 (inhibit-read-only t))
542
543 ;; If the other widget is already visible, delete it
544 (if (widget-get widget 'prj-other-widget)
545 (progn
546 (widget-delete (widget-get widget 'prj-other-widget))
547 (widget-put widget 'prj-other-widget nil)
548 (widget-default-value-set widget "Show Value")
549 )
550
551 ;; Else create it
552 (save-excursion
553 (mouse-set-point event)
554 (forward-line 1)
555 (beginning-of-line)
556 (widget-put widget 'prj-other-widget
557 (widget-create 'editable-list
558 :entry-format "%i%d %v"
559 :notify 'ada-prj-field-modified
560 :help-echo (widget-get widget 'prj-help)
561 :value value
562 (list 'editable-field
563 :keymap widget-keymap)))
564 (widget-default-value-set widget "Hide Value")
565 )
566 )
567 (widget-setup)
568 ))
569
570(defun ada-prj-field (field text help-text &optional is-list is-paths after-text)
571 "Create a widget to edit FIELD in the current buffer.
572TEXT is a short explanation of what the field means, whereas HELP-TEXT
573is the text displayed when the user pressed the help button.
574If IS-LIST is non-nil, the field contains a list. Otherwise, it contains
575a single string.
576if IS-PATHS is true, some special buttons are added to load paths,...
577AFTER-TEXT is inserted just after the widget."
578 (let ((value (plist-get ada-prj-current-values field))
579 (inhibit-read-only t)
580 widget)
581 (unless value
582 (set 'value
583 (if is-list '() "")))
584 (widget-insert text)
585 (widget-insert ":")
586 (move-to-column 54 t)
587 (widget-put (widget-create 'push-button
588 :notify 'ada-prj-display-help
589 "Help")
590 'prj-help
591 help-text)
592 (widget-insert (concat " (" (symbol-name field) ")\n"))
593 (if is-paths
594 (progn
595 (widget-create 'push-button
596 :notify
597 (list 'lambda '(&rest dummy) '(interactive)
598 (list 'ada-prj-load-from-file
599 (list 'quote field)))
600 "Load From File")
601 (widget-insert " ")
602 (widget-create 'push-button
603 :notify
604 (list 'lambda '(&rest dummy) '(interactive)
605 (list 'ada-prj-load-directory
606 (list 'quote field)))
607 "Load Recursive Directory")
608 (widget-insert "\n ${build_dir}\n")))
609 (set 'widget
610 (if is-list
611 (if (< (length value) 15)
612 (widget-create 'editable-list
613 :entry-format "%i%d %v"
614 :notify 'ada-prj-field-modified
615 :help-echo help-text
616 :value value
617 (list 'editable-field :keymap widget-keymap))
618 (let ((w (widget-create 'push-button
619 :notify 'ada-prj-show-value
620 "Show value")))
621 (widget-insert "\n")
622 (widget-put w 'prj-field field)
623 (widget-put w 'prj-help help-text)
624 (widget-put w 'prj-other-widget nil)
625 w)
626 )
627 (widget-create 'editable-field
628 :format "%v"
629 :notify 'ada-prj-field-modified
630 :help-echo help-text
631 :keymap widget-keymap
632 value)))
633 (widget-put widget 'prj-field field)
634 (if after-text
635 (widget-insert after-text))
636 (widget-insert "\n")
637 ))
452 638
453;; Initializations for the package
454(add-hook 'ada-mode-hook 'ada-prj-add-ada-menu)
455 639
456;; Set the keymap once and for all, so that the keys set by the user in his 640;; Set the keymap once and for all, so that the keys set by the user in his
457;; config file are not overwritten every time we open a new file. 641;; config file are not overwritten every time we open a new file.
458(ada-prj-add-keymap) 642(ada-prj-add-keymap)
643(ada-prj-add-ada-menu)
459 644
460(provide 'ada-prj) 645(provide 'ada-prj)
461;;; package ada-prj.el ends here 646;;; package ada-prj.el ends here
462
463
464