477 |
|
|
478 |
(defun ada-xref-update-project-menu () |
(defun ada-xref-update-project-menu () |
479 |
"Update the menu Ada->Project, with the list of available project files." |
"Update the menu Ada->Project, with the list of available project files." |
480 |
(let (submenu) |
;; Create the standard items. |
481 |
|
(let ((submenu |
482 |
;; Create the standard items |
`("Project" |
483 |
(set 'submenu (list (cons 'Load (cons "Load..." |
["Load..." ada-set-default-project-file t] |
484 |
'ada-set-default-project-file)) |
["New..." ada-prj-new t] |
485 |
(cons 'New (cons "New..." 'ada-prj-new)) |
["Edit..." ada-prj-edit t] |
486 |
(cons 'Edit (cons "Edit..." 'ada-prj-edit)) |
"---" |
487 |
(cons 'sep (cons "---" nil)))) |
;; Add the new items |
488 |
|
,@(mapcar |
489 |
;; Add the new items |
(lambda (x) |
490 |
(mapcar |
(let ((name (or (car x) "<default>")) |
491 |
(lambda (x) |
(command `(lambda () |
492 |
(let ((name (or (car x) "<default>")) |
"Change the active project file." |
493 |
(command `(lambda () |
(interactive) |
494 |
"Change the active project file." |
(ada-parse-prj-file ,(car x)) |
495 |
(interactive) |
(set 'ada-prj-default-project-file ,(car x)) |
496 |
(ada-parse-prj-file ,(car x)) |
(ada-xref-update-project-menu)))) |
497 |
(set 'ada-prj-default-project-file ,(car x)) |
(vector |
498 |
(ada-xref-update-project-menu)))) |
(if (string= (file-name-extension name) |
499 |
(set 'submenu |
ada-project-file-extension) |
500 |
(append submenu |
(file-name-sans-extension |
501 |
(list (cons (intern name) |
(file-name-nondirectory name)) |
502 |
(list |
(file-name-nondirectory name)) |
503 |
'menu-item |
command |
504 |
(if (string= (file-name-extension name) |
:button (cons |
505 |
ada-project-file-extension) |
:toggle |
506 |
(file-name-sans-extension |
(equal ada-prj-default-project-file |
507 |
(file-name-nondirectory name)) |
(car x)) |
508 |
(file-name-nondirectory name)) |
)))) |
509 |
command |
|
510 |
:button (cons |
;; Parses all the known project files, and insert at |
511 |
:toggle |
;; least the default one (in case |
512 |
(equal ada-prj-default-project-file |
;; ada-xref-project-files is nil) |
513 |
(car x)) |
(or ada-xref-project-files '(nil)))))) |
514 |
)))))))) |
|
515 |
|
(easy-menu-add-item ada-mode-menu '() submenu))) |
|
;; Parses all the known project files, and insert at least the default |
|
|
;; one (in case ada-xref-project-files is nil) |
|
|
(or ada-xref-project-files '(nil))) |
|
|
|
|
|
(if (not (featurep 'xemacs)) |
|
|
(if (lookup-key ada-mode-map [menu-bar Ada Project]) |
|
|
(setcdr (lookup-key ada-mode-map [menu-bar Ada Project]) |
|
|
submenu))) |
|
|
)) |
|
516 |
|
|
517 |
|
|
518 |
;;------------------------------------------------------------- |
;;------------------------------------------------------------- |
1033 |
(message "Cross-referencing information is not up-to-date. Please recompile.") |
(message "Cross-referencing information is not up-to-date. Please recompile.") |
1034 |
))))))) |
))))))) |
1035 |
|
|
1036 |
(defun ada-goto-declaration-other-frame (pos &optional other-frame) |
(defun ada-goto-declaration-other-frame (pos) |
1037 |
"Display the declaration of the identifier around POS. |
"Display the declaration of the identifier around POS. |
1038 |
The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." |
The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." |
1039 |
(interactive "d") |
(interactive "d") |
1242 |
(if (or arg ada-xref-confirm-compile) |
(if (or arg ada-xref-confirm-compile) |
1243 |
(set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) |
(set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) |
1244 |
|
|
1245 |
(let ((old-comint-exec (symbol-function 'comint-exec)) |
(let ((old-comint-exec (symbol-function 'comint-exec))) |
|
comint-exec |
|
|
in-post-mode |
|
|
gud-gdb-massage-args) |
|
1246 |
|
|
1247 |
;; Do not add -fullname, since we can have a 'rsh' command in front. |
;; Do not add -fullname, since we can have a 'rsh' command in front. |
1248 |
|
;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef |
1249 |
(fset 'gud-gdb-massage-args (lambda (file args) args)) |
(fset 'gud-gdb-massage-args (lambda (file args) args)) |
1250 |
|
|
1251 |
(set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) |
(set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) |
1254 |
|
|
1255 |
(set 'post-cmd (mapconcat 'identity post-cmd "\n")) |
(set 'post-cmd (mapconcat 'identity post-cmd "\n")) |
1256 |
(if post-cmd |
(if post-cmd |
1257 |
(set 'post-cmd (concat post-cmd "\n"))) |
(set 'post-cmd (concat post-cmd "\n"))) |
1258 |
|
|
1259 |
|
|
1260 |
;; Temporarily replaces the definition of `comint-exec' so that we |
;; Temporarily replaces the definition of `comint-exec' so that we |
1261 |
;; can execute commands before running gdb. |
;; can execute commands before running gdb. |
1262 |
(make-local-variable 'comint-exec) |
;; FIXME: This is evil and not temporary !!! -stef |
1263 |
(fset 'comint-exec |
(fset 'comint-exec |
1264 |
`(lambda (buffer name command startfile switches) |
`(lambda (buffer name command startfile switches) |
1265 |
(let (compilation-buffer-name-function) |
(let (compilation-buffer-name-function) |