Mercurial > emacs
comparison lisp/progmodes/ada-prj.el @ 25901:9f327fa7ac10
New file.
Easy editing of project files for the ada-mode
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 07 Oct 1999 14:31:47 +0000 |
parents | |
children | 1be4a89d81d3 |
comparison
equal
deleted
inserted
replaced
25900:f14be0689a02 | 25901:9f327fa7ac10 |
---|---|
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 |