* lisp/minibuffer.el (completion-file-name-table): Don't return a boundary
[emacs.git] / lisp / progmodes / ada-prj.el
blob0ae93c392a71e92673bb03822a6e08231eea132a
1 ;;; ada-prj.el --- GUI editing of project files for the ada-mode
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Emmanuel Briot <briot@gnat.com>
7 ;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
8 ;; Keywords: languages, ada, project file
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;;; This package provides a set of functions to easily edit the project
28 ;;; files used by the ada-mode.
29 ;;; The only function publicly available here is `ada-customize'.
30 ;;; See the documentation of the Ada mode for more information on the project
31 ;;; files.
32 ;;; Internally, a project file is represented as a property list, with each
33 ;;; field of the project file matching one property of the list.
36 ;;; History:
39 ;;; Code:
42 ;; ----- Requirements -----------------------------------------------------
44 (require 'cus-edit)
45 (require 'ada-xref)
47 (eval-when-compile
48 (require 'ada-mode))
50 ;; ----- Buffer local variables -------------------------------------------
52 (defvar ada-prj-current-values nil
53 "Hold the current value of the fields, This is a property list.")
54 (make-variable-buffer-local 'ada-prj-current-values)
56 (defvar ada-prj-default-values nil
57 "Hold the default value for the fields, This is a property list.")
58 (make-variable-buffer-local 'ada-prj-default-values)
60 (defvar ada-prj-ada-buffer nil
61 "Indicates what Ada source file was being edited.")
63 (defvar ada-old-cross-prefix nil
64 "The cross-prefix associated with the currently loaded runtime library.")
67 ;; ----- Functions --------------------------------------------------------
69 (defun ada-prj-new ()
70 "Open a new project file."
71 (interactive)
72 (let* ((prj
73 (if (and ada-prj-default-project-file
74 (not (string= ada-prj-default-project-file "")))
75 ada-prj-default-project-file
76 "default.adp"))
77 (filename (read-file-name "Project file: "
78 (if prj "" nil)
79 nil
80 nil
81 prj)))
82 (if (not (string= (file-name-extension filename t) ".adp"))
83 (error "File name extension for project files must be .adp"))
85 (ada-customize nil filename)))
87 (defun ada-prj-edit ()
88 "Editing the project file associated with the current Ada buffer.
89 If there is none, opens a new project file."
90 (interactive)
91 (if ada-prj-default-project-file
92 (ada-customize)
93 (ada-prj-new)))
95 (defun ada-prj-initialize-values (symbol ada-buffer filename)
96 "Set SYMBOL to the property list of the project file FILENAME.
97 If FILENAME is null, read the file associated with ADA-BUFFER.
98 If no project file is found, return the default values."
99 ;; FIXME: rationalize arguments; make ada-buffer optional?
100 (if (and filename
101 (not (string= filename ""))
102 (assoc filename ada-xref-project-files))
103 (set symbol (copy-sequence (cdr (assoc filename ada-xref-project-files))))
105 ;; Set default values (except for the file name if this was given
106 ;; in the buffer
107 (set symbol (ada-default-prj-properties))
108 (if (and filename (not (string= filename "")))
109 (set symbol (plist-put (eval symbol) 'filename filename)))
113 (defun ada-prj-save-specific-option (field)
114 "Return the string to print in the project file to save FIELD.
115 If the current value of FIELD is the default value, return an empty string."
116 (if (string= (plist-get ada-prj-current-values field)
117 (plist-get ada-prj-default-values field))
119 (concat (symbol-name field)
120 "=" (plist-get ada-prj-current-values field) "\n")))
122 (defun ada-prj-save ()
123 "Save the edited project file."
124 (interactive)
125 (let ((file-name (or (plist-get ada-prj-current-values 'filename)
126 (read-file-name "Save project as: ")))
127 output)
128 (set 'output
129 (concat
131 ;; Save the fields that do not depend on the current buffer
132 ;; only if they are different from the default value
134 (ada-prj-save-specific-option 'comp_opt)
135 (ada-prj-save-specific-option 'bind_opt)
136 (ada-prj-save-specific-option 'link_opt)
137 (ada-prj-save-specific-option 'gnatmake_opt)
138 (ada-prj-save-specific-option 'gnatfind_opt)
139 (ada-prj-save-specific-option 'cross_prefix)
140 (ada-prj-save-specific-option 'remote_machine)
141 (ada-prj-save-specific-option 'debug_cmd)
143 ;; Always save the fields that depend on the current buffer
144 "main=" (plist-get ada-prj-current-values 'main) "\n"
145 "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n"
146 (ada-prj-set-list "check_cmd"
147 (plist-get ada-prj-current-values 'check_cmd)) "\n"
148 (ada-prj-set-list "make_cmd"
149 (plist-get ada-prj-current-values 'make_cmd)) "\n"
150 (ada-prj-set-list "comp_cmd"
151 (plist-get ada-prj-current-values 'comp_cmd)) "\n"
152 (ada-prj-set-list "run_cmd"
153 (plist-get ada-prj-current-values 'run_cmd)) "\n"
154 (ada-prj-set-list "src_dir"
155 (plist-get ada-prj-current-values 'src_dir)
156 t) "\n"
157 (ada-prj-set-list "obj_dir"
158 (plist-get ada-prj-current-values 'obj_dir)
159 t) "\n"
160 (ada-prj-set-list "debug_pre_cmd"
161 (plist-get ada-prj-current-values 'debug_pre_cmd))
162 "\n"
163 (ada-prj-set-list "debug_post_cmd"
164 (plist-get ada-prj-current-values 'debug_post_cmd))
165 "\n"
168 (find-file file-name)
169 (erase-buffer)
170 (insert output)
171 (save-buffer)
172 ;; kill the project buffer
173 (kill-buffer nil)
175 ;; kill the editor buffer
176 (kill-buffer "*Edit Ada Mode Project*")
178 ;; automatically set the new project file as the active one
179 (set 'ada-prj-default-project-file file-name)
181 ;; force Emacs to reread the project files
182 (ada-reread-prj-file file-name)
186 (defun ada-prj-load-from-file (symbol)
187 "Load SYMBOL value from file.
188 One item per line should be found in the file."
189 (save-excursion
190 (let ((file (read-file-name "File name: " nil nil t))
191 (buffer (current-buffer))
192 line
193 list)
194 (find-file file)
195 (widen)
196 (goto-char (point-min))
197 (while (not (eobp))
198 (set 'line (buffer-substring-no-properties
199 (point) (save-excursion (end-of-line) (point))))
200 (add-to-list 'list line)
201 (forward-line 1)
203 (kill-buffer nil)
204 (set-buffer buffer)
205 (set 'ada-prj-current-values
206 (plist-put ada-prj-current-values
207 symbol
208 (append (plist-get ada-prj-current-values symbol)
209 (reverse list))))
211 (ada-prj-display-page 2)
214 (defun ada-prj-subdirs-of (dir)
215 "Return a list of all the subdirectories of DIR, recursively."
216 (let ((subdirs (directory-files dir t "^[^.].*"))
217 (dirlist (list dir)))
218 (while subdirs
219 (if (file-directory-p (car subdirs))
220 (let ((sub (ada-prj-subdirs-of (car subdirs))))
221 (if sub
222 (set 'dirlist (append sub dirlist)))))
223 (set 'subdirs (cdr subdirs)))
224 dirlist))
226 (defun ada-prj-load-directory (field &optional file-name)
227 "Append to FIELD in the current project the subdirectories of FILE-NAME.
228 If FILE-NAME is nil, ask the user for the name."
230 ;; Do not use an external dialog for this, since it wouldn't allow
231 ;; the user to select a directory
232 (let ((use-dialog-box nil))
233 (unless file-name
234 (set 'file-name (read-file-name "Root directory: " nil nil t))))
236 (set 'ada-prj-current-values
237 (plist-put ada-prj-current-values
238 field
239 (append (plist-get ada-prj-current-values field)
240 (reverse (ada-prj-subdirs-of
241 (expand-file-name file-name))))))
242 (ada-prj-display-page 2))
244 (defun ada-prj-display-page (tab-num)
245 "Display page TAB-NUM in the notebook.
246 The current buffer must be the project editing buffer."
248 (let ((inhibit-read-only t))
249 (erase-buffer))
251 ;; Widget support in Emacs 21 requires that we clear the buffer first
252 (if (and (not (featurep 'xemacs)) (>= emacs-major-version 21))
253 (progn
254 (setq widget-field-new nil
255 widget-field-list nil)
256 (mapc (lambda (x) (delete-overlay x)) (car (overlay-lists)))
257 (mapc (lambda (x) (delete-overlay x)) (cdr (overlay-lists)))))
259 ;; Display the tabs
261 (widget-insert "\n Project configuration.\n
262 ___________ ____________ ____________ ____________ ____________\n / ")
263 (widget-create 'push-button :notify
264 (lambda (&rest dummy) (ada-prj-display-page 1)) "General")
265 (widget-insert " \\ / ")
266 (widget-create 'push-button :notify
267 (lambda (&rest dummy) (ada-prj-display-page 2)) "Paths")
268 (widget-insert " \\ / ")
269 (widget-create 'push-button :notify
270 (lambda (&rest dummy) (ada-prj-display-page 3)) "Switches")
271 (widget-insert " \\ / ")
272 (widget-create 'push-button :notify
273 (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu")
274 (widget-insert " \\ / ")
275 (widget-create 'push-button :notify
276 (lambda (&rest dummy) (ada-prj-display-page 5)) "Debugger")
277 (widget-insert " \\\n")
279 ;; Display the currently selected page
281 (cond
284 ;; First page (General)
286 ((= tab-num 1)
287 (widget-insert "/ \\/______________\\/______________\\/______________\\/______________\\\n")
289 (widget-insert "Project file name:\n")
290 (widget-insert (plist-get ada-prj-current-values 'filename))
291 (widget-insert "\n\n")
292 (ada-prj-field 'casing "Casing Exceptions"
293 "List of files that contain casing exception
294 dictionaries. All these files contain one
295 identifier per line, with a special casing.
296 The first file has the highest priority."
297 t nil
298 (mapconcat (lambda(x)
299 (concat " " x))
300 (ada-xref-get-project-field 'casing)
301 "\n")
303 (ada-prj-field 'main "Executable file name"
304 "Name of the executable generated when you
305 compile your application. This should include
306 the full directory name, using ${build_dir} if
307 you wish.")
308 (ada-prj-field 'build_dir "Build directory"
309 "Reference directory for relative paths in
310 src_dir and obj_dir below. This is also the directory
311 where the compilation is done.")
312 (ada-prj-field 'remote_machine "Name of the remote machine (if any)"
313 "If you want to remotely compile, debug and
314 run your application, specify the name of a
315 remote machine here. This capability requires
316 the 'rsh' protocol on the remote machine.")
317 (ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain"
318 "When working on multiple cross targets, it is
319 most convenient to specify the prefix of the
320 tool chain here. For instance, on PowerPc
321 vxworks, you would enter 'powerpc-wrs-vxworks-'.
322 To use JGNAT, enter 'j'.")
327 ;; Second page (Paths)
329 ((= tab-num 2)
330 (if (not (equal (plist-get ada-prj-current-values 'cross_prefix)
331 ada-old-cross-prefix))
332 (progn
333 (setq ada-old-cross-prefix
334 (plist-get ada-prj-current-values 'cross_prefix))
335 (ada-initialize-runtime-library ada-old-cross-prefix)))
338 (widget-insert "/_____________\\/ \\/______________\\/______________\\/______________\\\n")
339 (ada-prj-field 'src_dir "Source directories"
340 "Enter the list of directories where your Ada
341 sources can be found. These directories will be
342 used for the cross-references and for the default
343 compilation commands.
344 Note that src_dir includes both the build directory
345 and the standard runtime."
347 (mapconcat (lambda(x)
348 (concat " " x))
349 ada-xref-runtime-library-specs-path
350 "\n")
352 (widget-insert "\n\n")
354 (ada-prj-field 'obj_dir "Object directories"
355 "Enter the list of directories where the GNAT
356 library files (ALI files) can be found. These
357 files are used for cross-references and by the
358 gnatmake command.
359 Note that obj_dir includes both the build directory
360 and the standard runtime."
362 (mapconcat (lambda(x)
363 (concat " " x))
364 ada-xref-runtime-library-ali-path
365 "\n")
367 (widget-insert "\n\n")
371 ;; Third page (Switches)
373 ((= tab-num 3)
374 (widget-insert "/_____________\\/______________\\/ \\/______________\\/______________\\\n")
375 (ada-prj-field 'comp_opt "Switches for the compiler"
376 "These switches are used in the default
377 compilation commands, both for compiling a
378 single file and rebuilding the whole project")
379 (ada-prj-field 'bind_opt "Switches for the binder"
380 "These switches are used in the default build
381 command and are passed to the binder")
382 (ada-prj-field 'link_opt "Switches for the linker"
383 "These switches are used in the default build
384 command and are passed to the linker")
385 (ada-prj-field 'gnatmake_opt "Switches for gnatmake"
386 "These switches are used in the default gnatmake
387 command.")
388 (ada-prj-field 'gnatfind_opt "Switches for gnatfind"
389 "The command gnatfind is run every time the Ada/Goto/List_References menu.
390 You should for instance add -a if you are working in an environment
391 where most ALI files are write-protected, since otherwise they get
392 ignored by gnatfind and you don't see the references within.")
396 ;; Fourth page
398 ((= tab-num 4)
399 (widget-insert "/_____________\\/______________\\/______________\\/ \\/______________\\\n")
400 (widget-insert
401 "All the fields below can use variable substitution. The syntax is ${name},
402 where name is the name that appears after the Help buttons in this buffer. As
403 a special case, ${current} is replaced with the name of the file currently
404 edited, with directory name but no extension, whereas ${full_current} is
405 replaced with the name of the current file with directory name and
406 extension.\n")
407 (widget-insert
408 "The environment variables ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are set to
409 ${src_dir} and ${obj_dir} before running the compilation commands, so that you
410 don't need to specify the -aI and -aO switches on the command line\n")
411 (widget-insert
412 "You can reference any environment variable using the same ${...} syntax as
413 above, and put the name of the variable between the quotes.\n\n")
414 (ada-prj-field 'check_cmd
415 "Check syntax of a single file (menu Ada->Check File)"
416 "This command is run to check the syntax and semantics of a file.
417 The file name is added at the end of this command." t)
418 (ada-prj-field 'comp_cmd
419 "Compiling a single file (menu Ada->Compile File)"
420 "This command is run when the recompilation
421 of a single file is needed. The file name is
422 added at the end of this command." t)
423 (ada-prj-field 'make_cmd "Rebuilding the whole project (menu Ada->Build)"
424 "This command is run when you want to rebuild
425 your whole application. It is never issues
426 automatically and you will need to ask for it.
427 If remote_machine has been set, this command
428 will be executed on the remote machine." t)
429 (ada-prj-field 'run_cmd "Running the application (menu Ada->Run)"
430 "This command specifies how to run the
431 application, including any switch you need to
432 specify. If remote_machine has been set, this
433 command will be executed on the remote host." t)
437 ;; Fifth page
439 ((= tab-num 5)
440 (widget-insert "/_____________\\/______________\\/______________\\/______________\\/ \\\n")
441 (ada-prj-field 'debug_pre_cmd "Commands to execute before launching the
442 debugger"
443 "The following commands are executed one after the other before starting
444 the debugger. These can be used to set up your environment." t)
446 (ada-prj-field 'debug_cmd "Debugging the application"
447 "Specifies how to debug the application, possibly
448 remotely if remote_machine has been set. We
449 recommend the following debuggers:
450 > gdb
451 > gvd --tty
452 > ddd --tty -fullname -toolbar")
454 (ada-prj-field 'debug_post_cmd "Commands to execute in the debugger"
455 "The following commands are executed one in the debugger once it has been
456 started. These can be used to initialize the debugger, for instance to
457 connect to the target when working with cross-environments" t)
463 (widget-insert "______________________________________________________________________\n\n ")
464 (widget-create 'push-button
465 :notify (lambda (&rest ignore)
466 (setq ada-prj-current-values (ada-default-prj-properties))
467 (ada-prj-display-page 1))
468 "Reset to Default Values")
469 (widget-insert " ")
470 (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil))
471 "Cancel")
472 (widget-insert " ")
473 (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save))
474 "Save")
475 (widget-insert "\n\n")
477 (widget-setup)
478 (with-no-warnings
479 (beginning-of-buffer))
483 (defun ada-customize (&optional new-file filename)
484 "Edit the project file associated with the current buffer.
485 If there is none or NEW-FILE is non-nil, make a new one.
486 If FILENAME is given, edit that file."
487 (interactive)
489 (let ((ada-buffer (current-buffer))
490 (inhibit-read-only t))
492 ;; We can only edit interactively the standard ada-mode project files. If
493 ;; the user is using other formats for the project file (through hooks in
494 ;; `ada-load-project-hook', we simply edit the file
496 (if (and (not new-file)
497 (or ada-prj-default-project-file filename)
498 (string= (file-name-extension
499 (or filename ada-prj-default-project-file))
500 "gpr"))
501 (progn
502 (find-file ada-prj-default-project-file)
503 (add-hook 'after-save-hook 'ada-reread-prj-file t t)
506 (if filename
507 (ada-reread-prj-file filename)
508 (if (not (string= ada-prj-default-project-file ""))
509 (ada-reread-prj-file ada-prj-default-project-file)
510 (ada-reread-prj-file)))
512 (switch-to-buffer "*Edit Ada Mode Project*")
514 (ada-prj-initialize-values 'ada-prj-current-values
515 ada-buffer
516 ada-prj-default-project-file)
518 (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer)
520 (use-local-map (copy-keymap custom-mode-map))
521 (local-set-key "\C-x\C-s" 'ada-prj-save)
523 (make-local-variable 'widget-keymap)
524 (define-key widget-keymap "\C-x\C-s" 'ada-prj-save)
526 (set (make-local-variable 'ada-old-cross-prefix)
527 (ada-xref-get-project-field 'cross-prefix))
529 (ada-prj-display-page 1)
532 ;; ---------------- Utilities --------------------------------
534 (defun ada-prj-set-list (string ada-list &optional is-directory)
535 "Prepend STRING to strings in ADA-LIST, return new-line separated string.
536 If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly
537 converted to a directory name."
539 (mapconcat (lambda (x) (concat string "="
540 (if is-directory
541 (file-name-as-directory x)
542 x)))
543 ada-list "\n"))
546 (defun ada-prj-field-modified (widget &rest dummy)
547 "Callback for modification of WIDGET.
548 Remaining args DUMMY are ignored.
549 Save the change in `ada-prj-current-values' so that selecting
550 another page and coming back keeps the new value."
551 (set 'ada-prj-current-values
552 (plist-put ada-prj-current-values
553 (widget-get widget ':prj-field)
554 (widget-value widget))))
556 (defun ada-prj-display-help (widget widget-modified event)
557 "Callback for help button in WIDGET.
558 Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
559 (let ((text (widget-get widget 'prj-help)))
560 (if event
561 ;; If we have a mouse-event, popup a menu
562 (widget-choose "Help"
563 (mapcar (lambda (a) (cons a t))
564 (split-string text "\n"))
565 event)
566 ;; Else display the help string just before the next group of
567 ;; variables
568 (momentary-string-display
569 (concat "*****Help*****\n" text "\n**************\n")
570 (save-excursion (forward-line) (beginning-of-line) (point)))
573 (defun ada-prj-show-value (widget widget-modified event)
574 "Show the current field value in WIDGET.
575 Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
576 (let* ((field (widget-get widget ':prj-field))
577 (value (plist-get ada-prj-current-values field))
578 (inhibit-read-only t)
581 ;; If the other widget is already visible, delete it
582 (if (widget-get widget 'prj-other-widget)
583 (progn
584 (widget-delete (widget-get widget 'prj-other-widget))
585 (widget-put widget 'prj-other-widget nil)
586 (widget-put widget ':prj-field field)
587 (widget-default-value-set widget "Show Value")
590 ;; Else create it
591 (save-excursion
592 (mouse-set-point event)
593 (forward-line 1)
594 (beginning-of-line)
595 (setq w (widget-create 'editable-list
596 :entry-format "%i%d %v"
597 :notify 'ada-prj-field-modified
598 :help-echo (widget-get widget 'prj-help)
599 :value value
600 (list 'editable-field :keymap widget-keymap)))
601 (widget-put widget 'prj-other-widget w)
602 (widget-put w ':prj-field field)
603 (widget-put widget ':prj-field field)
604 (widget-default-value-set widget "Hide Value")
607 (widget-setup)
610 (defun ada-prj-field (field text help-text &optional is-list is-paths after-text)
611 "Create a widget to edit FIELD in the current buffer.
612 TEXT is a short explanation of what the field means, whereas HELP-TEXT
613 is the text displayed when the user pressed the help button.
614 If IS-LIST is non-nil, the field contains a list. Otherwise, it contains
615 a single string.
616 If IS-PATHS is true, some special buttons are added to load paths,...
617 AFTER-TEXT is inserted just after the widget."
618 (let ((value (plist-get ada-prj-current-values field))
619 (inhibit-read-only t)
620 widget)
621 (unless value
622 (set 'value
623 (if is-list '() "")))
624 (widget-insert text)
625 (widget-insert ":")
626 (move-to-column 54 t)
627 (widget-put (widget-create 'push-button
628 :notify 'ada-prj-display-help
629 "Help")
630 'prj-help
631 help-text)
632 (widget-insert (concat " (" (symbol-name field) ")\n"))
633 (if is-paths
634 (progn
635 (widget-create 'push-button
636 :notify
637 (list 'lambda '(&rest dummy) '(interactive)
638 (list 'ada-prj-load-from-file
639 (list 'quote field)))
640 "Load From File")
641 (widget-insert " ")
642 (widget-create 'push-button
643 :notify
644 (list 'lambda '(&rest dummy) '(interactive)
645 (list 'ada-prj-load-directory
646 (list 'quote field)))
647 "Load Recursive Directory")
648 (widget-insert "\n ${build_dir}\n")))
650 (set 'widget
651 (if is-list
652 (if (< (length value) 15)
653 (widget-create 'editable-list
654 :entry-format "%i%d %v"
655 :notify 'ada-prj-field-modified
656 :help-echo help-text
657 :value value
658 (list 'editable-field :keymap widget-keymap))
660 (let ((w (widget-create 'push-button
661 :notify 'ada-prj-show-value
662 "Show value")))
663 (widget-insert "\n")
664 (widget-put w 'prj-help help-text)
665 (widget-put w 'prj-other-widget nil)
668 (widget-create 'editable-field
669 :format "%v"
670 :notify 'ada-prj-field-modified
671 :help-echo help-text
672 :keymap widget-keymap
673 value)))
674 (widget-put widget ':prj-field field)
675 (if after-text
676 (widget-insert after-text))
677 (widget-insert "\n")
681 (provide 'ada-prj)
683 ;; arch-tag: 65978c77-816e-49c6-896e-6905605d1b4c
684 ;;; ada-prj.el ends here