Commit | Line | Data |
---|---|---|
d41832c5 GM |
1 | ;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode |
2 | ||
c6fa13e3 | 3 | ;; Copyright (C) 1998-1999 Free Software Foundation, Inc. |
d41832c5 GM |
4 | |
5 | ;; Author: Emmanuel Briot <briot@gnat.com> | |
c6fa13e3 | 6 | ;; Ada Core Technologies's version: $Revision: 1.44 $ |
d41832c5 GM |
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 | ||
d41832c5 GM |
25 | ;;; This package provides a set of functions to easily edit the project |
26 | ;;; files used by the ada-mode. | |
c6fa13e3 GM |
27 | ;;; The only function publicly available here is `ada-customize'. |
28 | ;;; See the documentation of the Ada mode for more information on the project | |
29 | ;;; files. | |
30 | ;;; Internally, a project file is represented as a property list, with each | |
31 | ;;; field of the project file matching one property of the list. | |
d41832c5 GM |
32 | |
33 | ;; Code: | |
34 | ||
35 | ||
36 | ;; ----- Requirements ----------------------------------------------------- | |
37 | ||
38 | (require 'cus-edit) | |
39 | ||
d41832c5 | 40 | ;; ----- Buffer local variables ------------------------------------------- |
d41832c5 | 41 | |
c6fa13e3 GM |
42 | (defvar ada-prj-current-values nil |
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" | |
d41832c5 | 58 | (interactive) |
c6fa13e3 GM |
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. | |
75 | If 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)))) | |
d41832c5 | 83 | |
c6fa13e3 GM |
84 | (defun ada-prj-add-ada-menu () |
85 | "Add a new submenu to the Ada menu. | |
86 | The items are added to the menu NAME in map MAP. NAME should be the same | |
87 | name as was passed to `ada-create-menu'." | |
d41832c5 GM |
88 | (if ada-xemacs |
89 | (progn | |
c6fa13e3 GM |
90 | (funcall (symbol-function 'add-menu-button) |
91 | '("Ada" "Project") | |
92 | ["Edit" ada-prj-edit t] "Associate") | |
93 | (funcall (symbol-function 'add-menu-button) | |
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)))) | |
d41832c5 GM |
100 | |
101 | (defun ada-prj-add-keymap () | |
eec3232e | 102 | "Add new keybindings for ada-prj." |
c6fa13e3 GM |
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. | |
107 | If FILENAME is null, read the file associated with ADA-BUFFER. If no | |
108 | project 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 | ||
d41832c5 | 135 | |
c6fa13e3 GM |
136 | (defun ada-prj-save-specific-option (field) |
137 | "Returns the string to print in the project file to save FIELD. | |
138 | If the current value of FIELD is the default value, returns an empty string." | |
139 | (if (string= (plist-get ada-prj-current-values field) | |
140 | (plist-get ada-prj-default-values field)) | |
141 | "" | |
142 | (concat (symbol-name field) | |
143 | "=" (plist-get ada-prj-current-values field) "\n"))) | |
d41832c5 GM |
144 | |
145 | (defun ada-prj-save () | |
c6fa13e3 | 146 | "Save the edited project file." |
d41832c5 | 147 | (interactive) |
c6fa13e3 GM |
148 | (let ((file-name (plist-get ada-prj-current-values 'filename)) |
149 | output) | |
150 | (set 'output | |
151 | (concat | |
152 | ||
153 | ;; Save the fields that do not depend on the current buffer | |
154 | ;; only if they are different from the default value | |
155 | ||
156 | (ada-prj-save-specific-option 'comp_opt) | |
157 | (ada-prj-save-specific-option 'bind_opt) | |
158 | (ada-prj-save-specific-option 'link_opt) | |
159 | (ada-prj-save-specific-option 'gnatmake_opt) | |
160 | (ada-prj-save-specific-option 'cross_prefix) | |
161 | (ada-prj-save-specific-option 'remote_machine) | |
162 | (ada-prj-save-specific-option 'comp_cmd) | |
163 | (ada-prj-save-specific-option 'check_cmd) | |
164 | (ada-prj-save-specific-option 'make_cmd) | |
165 | (ada-prj-save-specific-option 'run_cmd) | |
166 | (ada-prj-save-specific-option 'debug_cmd) | |
167 | ||
168 | ;; Always save the fields that depend on the current buffer | |
169 | (concat "main=" (plist-get ada-prj-current-values 'main) "\n") | |
170 | (concat "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n") | |
171 | (concat "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n") | |
172 | ||
173 | (ada-prj-set-list "casing" | |
174 | (plist-get ada-prj-current-values 'casing)) "\n" | |
175 | (ada-prj-set-list "src_dir" | |
176 | (plist-get ada-prj-current-values 'src_dir)) "\n" | |
177 | (ada-prj-set-list "obj_dir" | |
178 | (plist-get ada-prj-current-values 'obj_dir)) "\n" | |
179 | )) | |
180 | ||
d41832c5 GM |
181 | (find-file file-name) |
182 | (erase-buffer) | |
183 | (insert output) | |
184 | (save-buffer) | |
185 | ;; kill the project buffer | |
186 | (kill-buffer nil) | |
187 | ||
188 | ;; kill the editor buffer | |
189 | (kill-buffer "*Customize Ada Mode*") | |
190 | ||
191 | ;; automatically associates the current buffer with the | |
192 | ;; new project file | |
c6fa13e3 | 193 | (set (make-local-variable 'ada-prj-prj-file) file-name) |
d41832c5 | 194 | |
c6fa13e3 GM |
195 | ;; force Emacs to reread the project files |
196 | (ada-reread-prj-file file-name) | |
d41832c5 GM |
197 | ) |
198 | ) | |
199 | ||
c6fa13e3 GM |
200 | (defun ada-prj-load-from-file (symbol) |
201 | "Load SYMBOL value from file. One item per line should be found in the file." | |
202 | (save-excursion | |
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. | |
241 | If 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 | |
255 | a value between 1 and the maximum number of pages. | |
256 | The 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 | |
304 | compile your application. This should include | |
305 | the full directory name, using ${build_dir} if | |
306 | you wish.") | |
307 | (ada-prj-field 'main_unit "File name of the main unit" | |
308 | "Name of the file to pass to the gnatmake command, | |
309 | and that will create the executable. | |
310 | This should not include any directory specification.") | |
311 | (ada-prj-field 'build_dir "Build directory" | |
312 | "Reference directory for relative paths in | |
313 | src_dir and obj_dir below. This is also the directory | |
314 | where 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 | |
317 | run your application, specify the name of a | |
318 | remote machine here. This capability requires | |
319 | the '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 | |
322 | most convenient to specify the prefix of the | |
323 | tool chain here. For instance, on PowerPc | |
324 | vxworks, you would enter 'powerpc-wrs-vxworks-'. | |
325 | To use JGNAT, enter 'j'.") | |
326 | ) | |
d41832c5 | 327 | |
c6fa13e3 GM |
328 | |
329 | ;; | |
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 | |
336 | sources can be found. These directories will be | |
337 | used for the cross-references and for the default | |
338 | compilation commands. | |
339 | Note that src_dir includes both the build directory | |
340 | and 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") | |
d41832c5 | 348 | |
c6fa13e3 GM |
349 | (ada-prj-field 'obj_dir "Object directories" |
350 | "Enter the list of directories where the GNAT | |
351 | library files (ALI files) can be found. These | |
352 | files are used for cross-references and by the | |
353 | gnatmake command. | |
354 | Note that obj_dir includes both the build directory | |
355 | and 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 | ) | |
d41832c5 | 364 | |
c6fa13e3 GM |
365 | ;; |
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 | |
372 | compilation commands, both for compiling a | |
373 | single 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 | |
376 | command 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 | |
379 | command and are passed to the linker") | |
380 | (ada-prj-field 'gnatmake_opt "Switches for gnatmake" | |
381 | "These switches are used in the default gnatmake | |
382 | command.") | |
383 | ) | |
d41832c5 | 384 | |
c6fa13e3 GM |
385 | ;; |
386 | ;; Fourth page | |
387 | ;; | |
388 | ((= tab-num 4) | |
389 | (widget-insert "_/_____________\\/______________\\/______________\\/ \\_____\n\n") | |
390 | (widget-insert "All the fields below can use variable substitution\n") | |
391 | (widget-insert "The syntax is ${name}, where name is the name that\n") | |
392 | (widget-insert "appears after the Help buttons in this buffer.\n") | |
393 | (widget-insert "As a special case, ${current} is replaced with the name\n") | |
394 | (widget-insert "of the file currently edited, with directory name but\n") | |
395 | (widget-insert "no extension.\n\n") | |
396 | (widget-insert | |
397 | "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH\n") | |
398 | (widget-insert | |
399 | "are set to ${src_dir} and ${obj_dir} before running the compilation\n") | |
400 | (widget-insert | |
401 | "commands, so that you don't need to specify the -aI and -aO\n") | |
402 | (widget-insert | |
403 | "switches on the command line\n\n") | |
404 | ||
405 | (ada-prj-field 'check_cmd | |
406 | "Check syntax of a single file (menu Ada->Check File)" | |
407 | "This command is run to check the syntax and semantics of a file. | |
408 | The file name is added at the end of this command.") | |
409 | (ada-prj-field 'comp_cmd | |
410 | "Compiling a single file (menu Ada->Compile File)" | |
411 | "This command is run when the recompilation | |
412 | of a single file is needed. The file name is | |
413 | added at the end of this command.") | |
414 | (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)" | |
415 | "This command is run when you want to rebuild | |
416 | your whole application. It is never issues | |
417 | automatically and you will need to ask for it. | |
418 | If remote_machine has been set, this command | |
419 | will 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 | |
422 | application, including any switch you need to | |
423 | specify. If remote_machine has been set, this | |
424 | command will be executed on the remote host.") | |
425 | (ada-prj-field 'debug_cmd "Debugging the application" | |
426 | "Specifies how to debug the application, possibly | |
427 | remotely if remote_machine has been set. We | |
428 | recommend 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 | ) | |
d41832c5 | 454 | |
d41832c5 | 455 | |
c6fa13e3 GM |
456 | (defun ada-customize (&optional new-file filename) |
457 | "Edit the project file associated with the current buffer. | |
458 | If there is none or NEW-FILE is non-nil, make a new one. | |
459 | If FILENAME is given, edit that file." | |
460 | (interactive) | |
d41832c5 | 461 | |
c6fa13e3 GM |
462 | (let ((ada-buffer (current-buffer)) |
463 | (inhibit-read-only t)) | |
d41832c5 | 464 | |
c6fa13e3 GM |
465 | (ada-require-project-file) |
466 | ||
467 | (switch-to-buffer "*Customize Ada Mode*") | |
468 | (kill-all-local-variables) | |
469 | ||
470 | (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer) | |
471 | (ada-prj-initialize-values 'ada-prj-current-values ada-buffer filename) | |
d41832c5 | 472 | |
c6fa13e3 | 473 | (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer) |
d41832c5 | 474 | |
c6fa13e3 GM |
475 | (use-local-map (copy-keymap custom-mode-map)) |
476 | (local-set-key "\C-x\C-s" 'ada-prj-save) | |
d41832c5 | 477 | |
c6fa13e3 GM |
478 | (make-local-variable 'widget-keymap) |
479 | (define-key widget-keymap "\C-x\C-s" 'ada-prj-save) | |
d41832c5 | 480 | |
c6fa13e3 GM |
481 | (ada-prj-display-page 1) |
482 | )) | |
d41832c5 GM |
483 | |
484 | ;; ---------------- Utilities -------------------------------- | |
485 | ||
c6fa13e3 | 486 | (defun ada-prj-set-list (string ada-dir-list) |
eec3232e GM |
487 | "Join the strings in ADA-DIR-LIST into a single string. Each name is put |
488 | on a separate line that begins with STRING." | |
c6fa13e3 | 489 | (mapconcat (lambda (x) (concat string "=" (file-name-as-directory x))) |
d41832c5 GM |
490 | ada-dir-list "\n")) |
491 | ||
c6fa13e3 | 492 | |
d41832c5 | 493 | (defun ada-prj-get-prj-dir (&optional ada-file) |
eec3232e GM |
494 | "Returns the directory/name of the project file for ADA-FILE. |
495 | If ADA-FILE is nil, returns the project file for the current buffer." | |
d41832c5 GM |
496 | (unless ada-file |
497 | (setq ada-file (buffer-file-name))) | |
498 | ||
499 | (save-excursion | |
500 | (set-buffer (get-file-buffer ada-file)) | |
c6fa13e3 GM |
501 | |
502 | (let ((prj-file (ada-prj-find-prj-file t))) | |
503 | (if (or (not prj-file) | |
504 | (not (file-exists-p prj-file)) | |
505 | ) | |
506 | (setq prj-file | |
507 | (concat (file-name-sans-extension ada-file) | |
508 | ada-project-file-extension))) | |
509 | prj-file) | |
510 | )) | |
d41832c5 | 511 | |
c6fa13e3 GM |
512 | (defun ada-prj-field-modified (widget &rest dummy) |
513 | "Callback called each time the value of WIDGET is modified. Save the | |
514 | change in ada-prj-current-values so that selecting another page and coming | |
515 | back 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 | |
523 | this 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. | |
572 | TEXT is a short explanation of what the field means, whereas HELP-TEXT | |
573 | is the text displayed when the user pressed the help button. | |
574 | If IS-LIST is non-nil, the field contains a list. Otherwise, it contains | |
575 | a single string. | |
576 | if IS-PATHS is true, some special buttons are added to load paths,... | |
577 | AFTER-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 | )) | |
d41832c5 | 638 | |
d41832c5 GM |
639 | |
640 | ;; Set the keymap once and for all, so that the keys set by the user in his | |
641 | ;; config file are not overwritten every time we open a new file. | |
642 | (ada-prj-add-keymap) | |
c6fa13e3 | 643 | (ada-prj-add-ada-menu) |
d41832c5 GM |
644 | |
645 | (provide 'ada-prj) | |
646 | ;;; package ada-prj.el ends here |