1 ;;; @(#) ada-prj.el --- Easy editing of project files for the ada-mode
3 ;; Copyright (C) 1998, 1999 Free Software Foundation, Inc.
5 ;; Author: Emmanuel Briot <briot@gnat.com>
6 ;; Ada Core Technologies's version: $Revision: 1.3 $
7 ;; Keywords: languages, ada, project file
9 ;; This file is not part of GNU Emacs.
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)
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.
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.
25 ;;; This package provides a set of functions to easily edit the project
26 ;;; files used by the ada-mode.
27 ;;; The only function publicly available here is `ada-customize'.
28 ;;; See the documentation of the Ada mode for more information on the project
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.
36 ;; ----- Requirements -----------------------------------------------------
40 ;; ----- Buffer local variables -------------------------------------------
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
)
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
)
50 (defvar ada-prj-ada-buffer nil
51 "Indicates what Ada source file was being edited.")
54 ;; ----- Functions --------------------------------------------------------
57 "Open a new project file"
60 (if (my-local-variable-if-set-p 'ada-prj-prj-file
(current-buffer))
63 (filename (read-file-name "Project file: "
68 (if (not (string= (file-name-extension filename t
) ".adp"))
69 (error "File name extension for project files must be .adp"))
71 (ada-customize nil filename
)))
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"
77 (let ((file (ada-prj-find-prj-file)))
80 (ada-reread-prj-file file
)
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'."
90 (funcall (symbol-function 'add-menu-button
)
92 ["Edit" ada-prj-edit t
] "Associate")
93 (funcall (symbol-function 'add-menu-button
)
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))))
101 (defun ada-prj-add-keymap ()
102 "Add new keybindings for ada-prj."
103 (define-key ada-mode-map "\C-cu" 'ada-prj-edit))
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."
110 (let ((prj filename))
113 ;; If filename is given, reread if first if needed
114 (if (file-exists-p filename)
115 (ada-reread-prj-file))
117 ;; Else use the one from the current buffer
119 (set-buffer ada-buffer)
120 (set 'prj ada-prj-prj-file)))
124 (not (string= prj ""))
125 (assoc prj ada-xref-project-files))
126 (set symbol (copy-sequence (cdr (assoc prj ada-xref-project-files))))
128 ;; Set default values (except for the file name if this was given
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)))
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))
142 (concat (symbol-name field)
143 "=" (plist-get ada-prj-current-values field) "\n")))
145 (defun ada-prj-save ()
146 "Save the edited project file."
148 (let ((file-name (plist-get ada-prj-current-values 'filename))
153 ;; Save the fields that do not depend on the current buffer
154 ;; only if they are different from the default value
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)
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")
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"
181 (find-file file-name)
185 ;; kill the project buffer
188 ;; kill the editor buffer
189 (kill-buffer "*Customize Ada Mode*")
191 ;; automatically associates the current buffer with the
193 (set (make-local-variable 'ada-prj-prj-file) file-name)
195 ;; force Emacs to reread the project files
196 (ada-reread-prj-file file-name)
200 (defun ada-prj-load-from-file (symbol)
201 "Load SYMBOL value from file. One item per line should be found in the file."
203 (let ((file (read-file-name "File name: " nil nil t))
204 (buffer (current-buffer))
209 (goto-char (point-min))
211 (set 'line (buffer-substring-no-properties
212 (point) (save-excursion (end-of-line) (point))))
213 (add-to-list 'list line)
218 (set 'ada-prj-current-values
219 (plist-put ada-prj-current-values
221 (append (plist-get ada-prj-current-values symbol)
224 (ada-prj-display-page 2)
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)))
232 (if (file-directory-p (car subdirs))
233 (let ((sub (ada-prj-subdirs-of (car subdirs))))
235 (set 'dirlist (append sub dirlist)))))
236 (set 'subdirs (cdr subdirs)))
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."
243 (set 'file-name (read-file-name "Root directory: " nil nil t)))
245 (set 'ada-prj-current-values
246 (plist-put ada-prj-current-values
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))
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."
258 (let ((inhibit-read-only t))
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")
278 ;; Display the currently selected page
283 ;; First page (General)
286 (widget-insert "_/ \\/______________\\/______________\\/______________\\_____\n\n")
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
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."
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
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'.")
330 ;; Second page (Paths)
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."
342 (mapconcat (lambda(x)
344 ada-xref-runtime-library-specs-path
347 (widget-insert "\n\n")
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
354 Note that obj_dir includes both the build directory
355 and the standard runtime."
357 (mapconcat (lambda(x)
359 ada-xref-runtime-library-ali-path
362 (widget-insert "\n\n")
366 ;; Third page (Switches)
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
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")
397 "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH\n")
399 "are set to ${src_dir} and ${obj_dir} before running the compilation\n")
401 "commands, so that you don't need to specify the -aI and -aO\n")
403 "switches on the command line\n\n")
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:
431 > ddd --tty -fullname -toolbar")
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")
444 (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil))
447 (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save))
449 (widget-insert "\n\n")
452 (beginning-of-buffer)
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."
462 (let ((ada-buffer (current-buffer))
463 (inhibit-read-only t))
465 (ada-require-project-file)
467 (switch-to-buffer "*Customize Ada Mode*")
468 (kill-all-local-variables)
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)
473 (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
475 (use-local-map (copy-keymap custom-mode-map))
476 (local-set-key "\C-x\C-s" 'ada-prj-save)
478 (make-local-variable 'widget-keymap)
479 (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
481 (ada-prj-display-page 1)
484 ;; ---------------- Utilities --------------------------------
486 (defun ada-prj-set-list (string ada-dir-list)
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."
489 (mapconcat (lambda (x) (concat string "=" (file-name-as-directory x)))
493 (defun ada-prj-get-prj-dir (&optional ada-file)
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."
497 (setq ada-file (buffer-file-name)))
500 (set-buffer (get-file-buffer ada-file))
502 (let ((prj-file (ada-prj-find-prj-file t)))
503 (if (or (not prj-file)
504 (not (file-exists-p prj-file))
507 (concat (file-name-sans-extension ada-file)
508 ada-project-file-extension)))
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))))
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)))
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"))
531 ;; Else display the help string just before the next group of
533 (momentary-string-display
534 (concat "*****Help*****\n" text "\n**************\n")
535 (save-excursion (forward-line) (beginning-of-line) (point)))
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))
543 ;; If the other widget is already visible, delete it
544 (if (widget-get widget 'prj-other-widget)
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")
553 (mouse-set-point event)
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)
562 (list 'editable-field
563 :keymap widget-keymap)))
564 (widget-default-value-set widget "Hide Value")
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
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)
583 (if is-list '() "")))
586 (move-to-column 54 t)
587 (widget-put (widget-create 'push-button
588 :notify 'ada-prj-display-help
592 (widget-insert (concat " (" (symbol-name field) ")\n"))
595 (widget-create 'push-button
597 (list 'lambda '(&rest dummy) '(interactive)
598 (list 'ada-prj-load-from-file
599 (list 'quote field)))
602 (widget-create 'push-button
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")))
611 (if (< (length value) 15)
612 (widget-create 'editable-list
613 :entry-format "%i%d %v"
614 :notify 'ada-prj-field-modified
617 (list 'editable-field :keymap widget-keymap))
618 (let ((w (widget-create 'push-button
619 :notify 'ada-prj-show-value
622 (widget-put w 'prj-field field)
623 (widget-put w 'prj-help help-text)
624 (widget-put w 'prj-other-widget nil)
627 (widget-create 'editable-field
629 :notify 'ada-prj-field-modified
631 :keymap widget-keymap
633 (widget-put widget 'prj-field field)
635 (widget-insert after-text))
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.
643 (ada-prj-add-ada-menu)
646 ;;; package ada-prj.el ends here