1 |
;;; ada-prj.el --- easy editing of project files for the ada-mode |
;;; ada-prj.el --- easy editing of project files for the ada-mode |
2 |
|
|
3 |
;; Copyright (C) 1998, 99, 2000, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 99, 2000, 2001, 2002 |
4 |
|
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Emmanuel Briot <briot@gnat.com> |
;; Author: Emmanuel Briot <briot@gnat.com> |
7 |
;; Ada Core Technologies's version: $Revision$ |
;; Ada Core Technologies's version: Revision: 1.55.2.2 (GNAT 3.15) |
8 |
;; Keywords: languages, ada, project file |
;; Keywords: languages, ada, project file |
9 |
|
|
10 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
75 |
prj))) |
prj))) |
76 |
(if (not (string= (file-name-extension filename t) ".adp")) |
(if (not (string= (file-name-extension filename t) ".adp")) |
77 |
(error "File name extension for project files must be .adp")) |
(error "File name extension for project files must be .adp")) |
78 |
|
|
79 |
(ada-customize nil filename))) |
(ada-customize nil filename))) |
80 |
|
|
81 |
(defun ada-prj-edit () |
(defun ada-prj-edit () |
82 |
"Editing the project file associated with the current Ada buffer. |
"Editing the project file associated with the current Ada buffer. |
83 |
If there is none, opens a new project file" |
If there is none, opens a new project file" |
84 |
(interactive) |
(interactive) |
85 |
(let ((file (ada-prj-find-prj-file))) |
(if ada-prj-default-project-file |
86 |
(if file |
(ada-customize) |
87 |
(progn |
(ada-prj-new))) |
|
(ada-reread-prj-file file) |
|
|
(ada-customize)) |
|
|
(ada-prj-new)))) |
|
88 |
|
|
89 |
(defun ada-prj-add-keymap () |
(defun ada-prj-add-keymap () |
90 |
"Add new keybindings for ada-prj." |
"Add new keybindings for ada-prj." |
105 |
;; Else use the active one |
;; Else use the active one |
106 |
(set 'prj ada-prj-default-project-file)) |
(set 'prj ada-prj-default-project-file)) |
107 |
|
|
108 |
|
|
109 |
(if (and prj |
(if (and prj |
110 |
(not (string= prj "")) |
(not (string= prj "")) |
111 |
(assoc prj ada-xref-project-files)) |
(assoc prj ada-xref-project-files)) |
112 |
(set symbol (copy-sequence (cdr (assoc prj ada-xref-project-files)))) |
(set symbol (copy-sequence (cdr (assoc prj ada-xref-project-files)))) |
113 |
|
|
114 |
;; Set default values (except for the file name if this was given |
;; Set default values (except for the file name if this was given |
115 |
;; in the buffer |
;; in the buffer |
116 |
(ada-xref-set-default-prj-values symbol ada-buffer) |
(ada-xref-set-default-prj-values symbol ada-buffer) |
117 |
(if (and prj (not (string= prj ""))) |
(if (and prj (not (string= prj ""))) |
118 |
(set symbol (plist-put (eval symbol) 'filename prj))) |
(set symbol (plist-put (eval symbol) 'filename prj))) |
119 |
))) |
))) |
120 |
|
|
121 |
|
|
122 |
(defun ada-prj-save-specific-option (field) |
(defun ada-prj-save-specific-option (field) |
123 |
"Returns the string to print in the project file to save FIELD. |
"Returns the string to print in the project file to save FIELD. |
138 |
|
|
139 |
;; Save the fields that do not depend on the current buffer |
;; Save the fields that do not depend on the current buffer |
140 |
;; only if they are different from the default value |
;; only if they are different from the default value |
141 |
|
|
142 |
(ada-prj-save-specific-option 'comp_opt) |
(ada-prj-save-specific-option 'comp_opt) |
143 |
(ada-prj-save-specific-option 'bind_opt) |
(ada-prj-save-specific-option 'bind_opt) |
144 |
(ada-prj-save-specific-option 'link_opt) |
(ada-prj-save-specific-option 'link_opt) |
173 |
(plist-get ada-prj-current-values 'debug_post_cmd)) |
(plist-get ada-prj-current-values 'debug_post_cmd)) |
174 |
"\n" |
"\n" |
175 |
)) |
)) |
176 |
|
|
177 |
(find-file file-name) |
(find-file file-name) |
178 |
(erase-buffer) |
(erase-buffer) |
179 |
(insert output) |
(insert output) |
234 |
(defun ada-prj-load-directory (field &optional file-name) |
(defun ada-prj-load-directory (field &optional file-name) |
235 |
"Append the content of FILE-NAME to FIELD in the current project file. |
"Append the content of FILE-NAME to FIELD in the current project file. |
236 |
If FILE-NAME is nil, ask the user for the name." |
If FILE-NAME is nil, ask the user for the name." |
237 |
(unless file-name |
|
238 |
(set 'file-name (read-file-name "Root directory: " nil nil t))) |
;; Do not use an external dialog for this, since it wouldn't allow |
239 |
|
;; the user to select a directory |
240 |
|
(let ((use-dialog-box nil)) |
241 |
|
(unless file-name |
242 |
|
(set 'file-name (read-file-name "Root directory: " nil nil t)))) |
243 |
|
|
244 |
(set 'ada-prj-current-values |
(set 'ada-prj-current-values |
245 |
(plist-put ada-prj-current-values |
(plist-put ada-prj-current-values |
264 |
widget-field-list nil) |
widget-field-list nil) |
265 |
(mapcar (lambda (x) (delete-overlay x)) (car (overlay-lists))) |
(mapcar (lambda (x) (delete-overlay x)) (car (overlay-lists))) |
266 |
(mapcar (lambda (x) (delete-overlay x)) (cdr (overlay-lists))))) |
(mapcar (lambda (x) (delete-overlay x)) (cdr (overlay-lists))))) |
267 |
|
|
268 |
;; Display the tabs |
;; Display the tabs |
269 |
|
|
270 |
(widget-insert "\n Project and Editor configuration.\n |
(widget-insert "\n Project and Editor configuration.\n |
271 |
___________ ____________ ____________ ____________ ____________\n / ") |
___________ ____________ ____________ ____________ ____________\n / ") |
272 |
(widget-create 'push-button :notify |
(widget-create 'push-button :notify |
286 |
(widget-insert " \\\n") |
(widget-insert " \\\n") |
287 |
|
|
288 |
;; Display the currently selected page |
;; Display the currently selected page |
289 |
|
|
290 |
(cond |
(cond |
291 |
|
|
292 |
;; |
;; |
293 |
;; First page (General) |
;; First page (General) |
294 |
;; |
;; |
335 |
To use JGNAT, enter 'j'.") |
To use JGNAT, enter 'j'.") |
336 |
) |
) |
337 |
|
|
338 |
|
|
339 |
;; |
;; |
340 |
;; Second page (Paths) |
;; Second page (Paths) |
341 |
;; |
;; |
347 |
(plist-get ada-prj-current-values 'cross_prefix)) |
(plist-get ada-prj-current-values 'cross_prefix)) |
348 |
(ada-initialize-runtime-library ada-old-cross-prefix))) |
(ada-initialize-runtime-library ada-old-cross-prefix))) |
349 |
|
|
350 |
|
|
351 |
(widget-insert "/_____________\\/ \\/______________\\/______________\\/______________\\\n") |
(widget-insert "/_____________\\/ \\/______________\\/______________\\/______________\\\n") |
352 |
(ada-prj-field 'src_dir "Source directories" |
(ada-prj-field 'src_dir "Source directories" |
353 |
"Enter the list of directories where your Ada |
"Enter the list of directories where your Ada |
363 |
"\n") |
"\n") |
364 |
) |
) |
365 |
(widget-insert "\n\n") |
(widget-insert "\n\n") |
366 |
|
|
367 |
(ada-prj-field 'obj_dir "Object directories" |
(ada-prj-field 'obj_dir "Object directories" |
368 |
"Enter the list of directories where the GNAT |
"Enter the list of directories where the GNAT |
369 |
library files (ALI files) can be found. These |
library files (ALI files) can be found. These |
397 |
command and are passed to the linker") |
command and are passed to the linker") |
398 |
(ada-prj-field 'gnatmake_opt "Switches for gnatmake" |
(ada-prj-field 'gnatmake_opt "Switches for gnatmake" |
399 |
"These switches are used in the default gnatmake |
"These switches are used in the default gnatmake |
400 |
command.") |
command.") |
401 |
(ada-prj-field 'gnatfind_opt "Switches for gnatfind" |
(ada-prj-field 'gnatfind_opt "Switches for gnatfind" |
402 |
"The command gnatfind is run every time the Ada/Goto/List_References menu. |
"The command gnatfind is run every time the Ada/Goto/List_References menu. |
403 |
You should for instance add -a if you are working in an environment |
You should for instance add -a if you are working in an environment |
455 |
debugger" |
debugger" |
456 |
"The following commands are executed one after the other before starting |
"The following commands are executed one after the other before starting |
457 |
the debugger. These can be used to set up your environment." t) |
the debugger. These can be used to set up your environment." t) |
458 |
|
|
459 |
(ada-prj-field 'debug_cmd "Debugging the application" |
(ada-prj-field 'debug_cmd "Debugging the application" |
460 |
"Specifies how to debug the application, possibly |
"Specifies how to debug the application, possibly |
461 |
remotely if remote_machine has been set. We |
remotely if remote_machine has been set. We |
469 |
started. These can be used to initialize the debugger, for instance to |
started. These can be used to initialize the debugger, for instance to |
470 |
connect to the target when working with cross-environments" t) |
connect to the target when working with cross-environments" t) |
471 |
) |
) |
472 |
|
|
473 |
) |
) |
474 |
|
|
475 |
|
|
502 |
(let ((ada-buffer (current-buffer)) |
(let ((ada-buffer (current-buffer)) |
503 |
(inhibit-read-only t)) |
(inhibit-read-only t)) |
504 |
|
|
505 |
(ada-require-project-file) |
;; We can only edit interactively the standard ada-mode project files. If |
506 |
|
;; the user is using other formats for the project file (through hooks in |
507 |
(switch-to-buffer "*Customize Ada Mode*") |
;; `ada-load-project-hook', we simply edit the file |
508 |
(kill-all-local-variables) |
|
509 |
|
(if (and (not new-file) |
510 |
(ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer) |
(or ada-prj-default-project-file filename) |
511 |
(ada-prj-initialize-values 'ada-prj-current-values ada-buffer filename) |
(string= (file-name-extension |
512 |
|
(or filename ada-prj-default-project-file)) |
513 |
(set (make-local-variable 'ada-prj-ada-buffer) ada-buffer) |
"gpr")) |
514 |
|
(progn |
515 |
(use-local-map (copy-keymap custom-mode-map)) |
(find-file ada-prj-default-project-file) |
516 |
(local-set-key "\C-x\C-s" 'ada-prj-save) |
(add-hook 'after-save-hook 'ada-reread-prj-file t t) |
517 |
|
) |
518 |
|
|
519 |
|
;; Else start the interactive editor |
520 |
|
(switch-to-buffer "*Customize Ada Mode*") |
521 |
|
(kill-all-local-variables) |
522 |
|
|
523 |
(make-local-variable 'widget-keymap) |
(ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer) |
524 |
(define-key widget-keymap "\C-x\C-s" 'ada-prj-save) |
(ada-prj-initialize-values |
525 |
|
'ada-prj-current-values ada-buffer filename) |
526 |
|
|
527 |
(set (make-local-variable 'ada-old-cross-prefix) |
(set (make-local-variable 'ada-prj-ada-buffer) ada-buffer) |
|
(ada-xref-get-project-field 'cross-prefix)) |
|
528 |
|
|
529 |
(ada-prj-display-page 1) |
(use-local-map (copy-keymap custom-mode-map)) |
530 |
)) |
(local-set-key "\C-x\C-s" 'ada-prj-save) |
531 |
|
|
532 |
|
(make-local-variable 'widget-keymap) |
533 |
|
(define-key widget-keymap "\C-x\C-s" 'ada-prj-save) |
534 |
|
|
535 |
|
(set (make-local-variable 'ada-old-cross-prefix) |
536 |
|
(ada-xref-get-project-field 'cross-prefix)) |
537 |
|
|
538 |
|
(ada-prj-display-page 1) |
539 |
|
))) |
540 |
|
|
541 |
;; ---------------- Utilities -------------------------------- |
;; ---------------- Utilities -------------------------------- |
542 |
|
|
560 |
(setq ada-file (buffer-file-name))) |
(setq ada-file (buffer-file-name))) |
561 |
|
|
562 |
(save-excursion |
(save-excursion |
|
(set-buffer (get-file-buffer ada-file)) |
|
|
|
|
563 |
(let ((prj-file (ada-prj-find-prj-file t))) |
(let ((prj-file (ada-prj-find-prj-file t))) |
564 |
(if (or (not prj-file) |
(if (or (not prj-file) |
565 |
(not (file-exists-p prj-file)) |
(not (file-exists-p prj-file)) |