25901
|
1 ;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode
|
|
2
|
|
3 ;; Copyright (C) 1998, 1999 Ada Core Technologies, Inc
|
|
4
|
|
5 ;; Author: Emmanuel Briot <briot@gnat.com>
|
|
6 ;; Ada Core Technologies's version: $Revision: 1.30 $
|
|
7 ;; Keywords: languages, ada, project file
|
|
8
|
|
9 ;; This file is not part of GNU Emacs.
|
|
10
|
|
11 ;; This program is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
14 ;; any later version.
|
|
15
|
|
16 ;; This program is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
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.
|
|
24
|
|
25 ;;; Commentary:
|
|
26 ;;; This package provides a set of functions to easily edit the project
|
|
27 ;;; files used by the ada-mode.
|
|
28 ;;; The only function publicly available here is `ada-prj-customize'.
|
|
29 ;;; Please ada-mode.el and its documentation for more information about the
|
|
30 ;;; project files.
|
|
31 ;;;
|
|
32 ;;; You need Emacs >= 20.2 to run this package
|
|
33
|
|
34 ;; Code:
|
|
35
|
|
36
|
|
37 ;; ----- Requirements -----------------------------------------------------
|
|
38
|
|
39 (require 'cus-edit)
|
|
40
|
|
41
|
|
42 ;; ----- 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
|
|
68 (defun ada-prj-add-ada-menu ()
|
|
69 "Add a new submenu to the Ada menu"
|
|
70 (interactive)
|
|
71
|
|
72 (if ada-xemacs
|
|
73 (progn
|
|
74 (add-menu-button '("Ada" "Project") ["New/Edit" ada-customize t] "Associate")
|
|
75 )
|
|
76 (let ((prj-menu (lookup-key ada-mode-map [menu-bar Ada Project])))
|
|
77 (define-key prj-menu [New] '("New/Edit" . ada-customize)))
|
|
78 ))
|
|
79
|
|
80 (defun ada-prj-add-keymap ()
|
|
81 "Add new keybindings for ada-prj"
|
|
82 (define-key ada-mode-map "\C-cu" 'ada-customize))
|
|
83
|
|
84 (defun ada-customize (&optional new-file)
|
|
85 "Edit the project file associated with the current buffer, or
|
|
86 a new one if none is found"
|
|
87 (interactive)
|
|
88 (if new-file
|
|
89 (progn
|
|
90 (setq ada-prj-edit-use-default-values t)
|
|
91 (kill-local-variable 'ada-prj-prj-file)
|
|
92 (ada-prj-customize)
|
|
93 (setq ada-prj-edit-use-default-values nil))
|
|
94 (ada-prj-customize)))
|
|
95
|
|
96 (defun ada-prj-save ()
|
|
97 "save the edited project file"
|
|
98 (interactive)
|
|
99 (let ((file-name (widget-value ada-prj-widget-prj-dir))
|
|
100 value output)
|
|
101 (setq output
|
|
102 (concat
|
|
103 (ada-prj-set-list "src_dir" (widget-value ada-prj-widget-src-dir))
|
|
104 "\n"
|
|
105 (ada-prj-set-list "obj_dir" (widget-value ada-prj-widget-obj-dir))
|
|
106 "\n"
|
|
107 (unless (string= (setq value (widget-value ada-prj-widget-comp-opt))
|
|
108 (get 'ada-prj-default 'comp_opt))
|
|
109 (concat "comp_opt=" value "\n"))
|
|
110 (unless (string= (setq value (widget-value ada-prj-widget-bind-opt))
|
|
111 (get 'ada-prj-default 'bind_opt))
|
|
112 (concat "bind_opt=" value "\n"))
|
|
113 (unless (string= (setq value (widget-value ada-prj-widget-link-opt))
|
|
114 (get 'ada-prj-default 'link_opt))
|
|
115 (concat "link_opt=" value "\n"))
|
|
116 (unless (string= (setq value (widget-value ada-prj-widget-main))
|
|
117 (get 'ada-prj-default 'main))
|
|
118 (concat "main=" value "\n"))
|
|
119 (unless (string= (setq value (widget-value ada-prj-widget-cross-prefix))
|
|
120 (get 'ada-prj-default 'cross-prefix))
|
|
121 (concat "cross_prefix=" value "\n"))
|
|
122 (unless (string= (setq value (widget-value ada-prj-widget-remote-machine))
|
|
123 (get 'ada-prj-default 'remote-machine))
|
|
124 (concat "remote_machine=" value "\n"))
|
|
125 (unless (string= (setq value (widget-value ada-prj-widget-comp-cmd))
|
|
126 (get 'ada-prj-default 'comp_cmd))
|
|
127 (concat "comp_cmd=" value "\n"))
|
|
128 (unless (string= (setq value (widget-value ada-prj-widget-make-cmd))
|
|
129 (get 'ada-prj-default 'make_cmd))
|
|
130 (concat "make_cmd=" value "\n"))
|
|
131 (unless (string= (setq value (widget-value ada-prj-widget-run-cmd))
|
|
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)
|
|
139 (erase-buffer)
|
|
140 (insert output)
|
|
141 (save-buffer)
|
|
142 ;; kill the project buffer
|
|
143 (kill-buffer nil)
|
|
144
|
|
145 ;; kill the editor buffer
|
|
146 (kill-buffer "*Customize Ada Mode*")
|
|
147
|
|
148 ;; automatically associates the current buffer with the
|
|
149 ;; new project file
|
|
150 (make-local-variable 'ada-prj-prj-file)
|
|
151 (setq ada-prj-prj-file file-name)
|
|
152
|
|
153 ;; force emacs to reread the project files
|
|
154 (ada-reread-prj-file t)
|
|
155 )
|
|
156 )
|
|
157
|
|
158 (defun ada-prj-customize ()
|
|
159 "Edit the project file whose name is given by prj-file."
|
|
160 (let* ((old-name (buffer-file-name))
|
|
161 prj-file)
|
|
162
|
|
163 (unless old-name
|
|
164 (error
|
|
165 "No file name given for this buffer ! You need to open a file first"))
|
|
166
|
|
167 ;; Find the project file associated with the buffer
|
|
168 (setq prj-file (ada-prj-get-prj-dir old-name))
|
|
169
|
|
170 (switch-to-buffer "*Customize Ada Mode*")
|
|
171 (kill-all-local-variables)
|
|
172
|
|
173 ;; Find the default values
|
|
174 (setq ada-prj-default nil)
|
|
175 (put 'ada-prj-default 'src_dir (list (file-name-directory old-name)))
|
|
176 (put 'ada-prj-default 'obj_dir (list (file-name-directory old-name)))
|
|
177 (put 'ada-prj-default 'comp_opt "")
|
|
178 (put 'ada-prj-default 'bind_opt "")
|
|
179 (put 'ada-prj-default 'link_opt "")
|
|
180 (put 'ada-prj-default 'main "")
|
|
181 (put 'ada-prj-default 'cross_prefix "")
|
|
182 (put 'ada-prj-default 'remote_machine "")
|
|
183 (put 'ada-prj-default 'comp_cmd
|
|
184 (concat "cd " (file-name-directory old-name) " && "
|
|
185 ada-prj-default-comp-cmd))
|
|
186 (put 'ada-prj-default 'make_cmd
|
|
187 (concat "cd " (file-name-directory old-name) " && "
|
|
188 ada-prj-default-make-cmd))
|
|
189 (put 'ada-prj-default 'run_cmd (if is-windows "${main}.exe" "${main}"))
|
|
190 (put 'ada-prj-default 'debug_cmd
|
|
191 (if is-windows "${cross_prefix}gdb ${main}.exe"
|
|
192 "${cross_prefix}gdb ${main}"))
|
|
193
|
|
194 (let ((inhibit-read-only t))
|
|
195 (erase-buffer))
|
|
196
|
|
197 ;;; Overlay-lists is not defined on XEmacs
|
|
198 (if (fboundp 'overlay-lists)
|
|
199 (let ((all (overlay-lists)))
|
|
200 ;; Delete all the overlays.
|
|
201 (mapcar 'delete-overlay (car all))
|
|
202 (mapcar 'delete-overlay (cdr all))))
|
|
203
|
|
204 (use-local-map widget-keymap)
|
|
205 (local-set-key "\C-x\C-s" 'ada-prj-save)
|
|
206
|
|
207 (widget-insert "
|
|
208 ----------------------------------------------------------------
|
|
209 -- Customize your emacs ada mode for the current application --
|
|
210 ----------------------------------------------------------------
|
|
211 This buffer will allow you to create easily a project file for your application.
|
|
212 This file will tell emacs where to find the ada sources, the cross-referencing
|
|
213 informations, how to compile and run your application, ...
|
|
214
|
|
215 Please 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
|
|
228
|
|
229 ;; Create local variables with their initial value
|
|
230 (setq ada-prj-widget-prj-dir
|
|
231 (ada-prj-new 'ada-prj-widget-prj-dir nil "" prj-file
|
|
232 "\nName and directory of the project file.
|
|
233 Put a new name here if you want to create a new project file\n"))
|
|
234
|
|
235 (setq ada-prj-widget-src-dir
|
|
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
|
|
239 will 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
|
|
245 by the compiler will be found. This files are required for the cross-referencing
|
|
246 capabilities 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
|
|
272 set 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.
|
|
278 Leave an empty field if you want to compile on the local machine.
|
|
279 This will not work on Windows NT, since we only do a 'rsh' to the
|
|
280 remote 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
|
|
292 The easiest way is to ignore this possibility. These fields are intended only
|
|
293 for 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.
|
|
300 The name of the file to compile will be added at the end of the command.
|
|
301 This 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
|
|
320 below, to validate or cancel your modifications.
|
|
321 If 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
|
|
334
|
|
335 ;; if it exists, kill the project file buffer
|
|
336 (if (and prj-file
|
|
337 (get-file-buffer prj-file))
|
|
338 (kill-buffer (get-file-buffer prj-file)))
|
|
339
|
|
340 (widget-setup)
|
|
341 (beginning-of-buffer)
|
|
342 )
|
|
343 )
|
|
344
|
|
345
|
|
346 ;; ---------------- Utilities --------------------------------
|
|
347
|
|
348 (defun ada-prj-new (variable prj-file text default message)
|
|
349 "Create a buffer-local text variable, whose value is either read in
|
|
350 the prj-file or default
|
|
351 Then adds a text field (with MESSAGE), and returns the created widget"
|
|
352
|
|
353 ;; create local variable
|
|
354 (make-local-variable variable)
|
|
355 (let ((value default)
|
|
356 (regexp (concat "^" text "=\\(.*\\)")))
|
|
357 ;; if the project file exists
|
|
358 (if (and prj-file (not ada-prj-edit-use-default-values)
|
|
359 (file-readable-p prj-file))
|
|
360 ;; find the value
|
|
361 (save-excursion
|
|
362 (find-file prj-file)
|
|
363 (beginning-of-buffer)
|
|
364 (if (re-search-forward regexp nil t)
|
|
365 (setq value (match-string 1)))
|
|
366 ))
|
|
367 ;; assign a new value to the variable
|
|
368 (setq variable value))
|
|
369
|
|
370 (widget-insert message)
|
|
371
|
|
372 (widget-create 'editable-field
|
|
373 :format (if (string= text "") "%v"
|
|
374 (concat text "= %v"))
|
|
375 :keymap widget-keymap
|
|
376 variable))
|
|
377
|
|
378
|
|
379 (defun ada-prj-list (variable prj-file text default message)
|
|
380 "Create a buffer-local list variable, whose value is either read in
|
|
381 the prj-file or default
|
|
382 Then adds a list widget (with MESSAGE), and returns the created widget"
|
|
383
|
|
384 ;; create local variable
|
|
385 (make-local-variable variable)
|
|
386 (let ((value nil)
|
|
387 (regexp (concat "^" text "=\\(.*\\)")))
|
|
388 ;; if the project file exists
|
|
389 (if (and prj-file (not ada-prj-edit-use-default-values)
|
|
390 (file-readable-p prj-file))
|
|
391 ;; find the value
|
|
392 (save-excursion
|
|
393 (find-file prj-file)
|
|
394 (goto-char (point-min))
|
|
395 ;; for each line, add its value
|
|
396 (while
|
|
397 (re-search-forward regexp nil t)
|
|
398 (progn
|
|
399 (setq value (cons (match-string 1) value)))
|
|
400 )))
|
|
401
|
|
402 ;; assign a new value to the variable
|
|
403 (setq variable
|
|
404 (if value (reverse value) default)))
|
|
405
|
|
406 (widget-insert message)
|
|
407 (widget-create 'editable-list
|
|
408 :entry-format (concat text "= %i %d %v")
|
|
409 :value variable
|
|
410 (list 'editable-field :keymap widget-keymap)))
|
|
411
|
|
412 (defun ada-prj-set-list (string ada-dir-list)
|
|
413 "Creates a single string of blank-separated directory names"
|
|
414 (mapconcat (lambda (x)
|
|
415 (concat string "="
|
|
416 x
|
|
417 (unless (string=
|
|
418 (substring x -1)
|
|
419 "/")
|
|
420 "/")))
|
|
421 ada-dir-list "\n"))
|
|
422
|
|
423 (defun ada-prj-get-prj-dir (&optional ada-file)
|
|
424 "returns a string which is the directory/name of the prj file.
|
|
425 If no-standard-prj is t, do not use the default algorithm, just
|
|
426 use a default name"
|
|
427 (unless ada-file
|
|
428 (setq ada-file (buffer-file-name)))
|
|
429
|
|
430 (save-excursion
|
|
431 (set-buffer (get-file-buffer ada-file))
|
|
432 (if ada-prj-edit-use-default-values
|
|
433 (concat (file-name-sans-extension ada-file)
|
|
434 ada-project-file-extension)
|
|
435
|
|
436 (let ((prj-file (ada-prj-find-prj-file t)))
|
|
437 (if (or (not prj-file)
|
|
438 (not (file-exists-p prj-file))
|
|
439 )
|
|
440 (setq prj-file
|
|
441 (concat (file-name-sans-extension ada-file)
|
|
442 ada-project-file-extension)))
|
|
443 prj-file)
|
|
444 ))
|
|
445 )
|
|
446
|
|
447
|
|
448 ;; Initializations for the package
|
|
449 (add-hook 'ada-mode-hook 'ada-prj-add-ada-menu)
|
|
450
|
|
451 ;; Set the keymap once and for all, so that the keys set by the user in his
|
|
452 ;; config file are not overwritten every time we open a new file.
|
|
453 (ada-prj-add-keymap)
|
|
454
|
|
455 (provide 'ada-prj)
|
|
456 ;;; package ada-prj.el ends here
|
|
457
|
|
458
|
|
459
|