1 |
;;; ada-xref.el --- for lookup and completion in Ada mode |
;;; ada-xref.el --- for lookup and completion in Ada mode |
2 |
|
|
3 |
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002 |
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002, 2003 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> |
;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> |
7 |
;; Rolf Ebert <ebert@inf.enst.fr> |
;; Rolf Ebert <ebert@inf.enst.fr> |
8 |
;; Emmanuel Briot <briot@gnat.com> |
;; Emmanuel Briot <briot@gnat.com> |
9 |
;; Maintainer: Emmanuel Briot <briot@gnat.com> |
;; Maintainer: Emmanuel Briot <briot@gnat.com> |
10 |
;; Ada Core Technologies's version: Revision: 1.155.2.8 (GNAT 3.15) |
;; Ada Core Technologies's version: Revision: 1.181 |
11 |
;; Keywords: languages ada xref |
;; Keywords: languages ada xref |
12 |
|
|
13 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
66 |
Set to 0, if you don't use crunched filenames. This should be a string." |
Set to 0, if you don't use crunched filenames. This should be a string." |
67 |
:type 'string :group 'ada) |
:type 'string :group 'ada) |
68 |
|
|
69 |
|
(defcustom ada-gnatls-args '("-v") |
70 |
|
"*Arguments to pass to gnatfind when the location of the runtime is searched. |
71 |
|
Typical use is to pass --RTS=soft-floats on some systems that support it. |
72 |
|
|
73 |
|
You can also add -I- if you do not want the current directory to be included. |
74 |
|
Otherwise, going from specs to bodies and back will first look for files in the |
75 |
|
current directory. This only has an impact if you are not using project files, |
76 |
|
but only ADA_INCLUDE_PATH." |
77 |
|
:type '(repeat string) :group 'ada) |
78 |
|
|
79 |
(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ" |
(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ" |
80 |
"Default compilation options." |
"Default compilation options." |
81 |
:type 'string :group 'ada) |
:type 'string :group 'ada) |
212 |
\((project_name . value) (project_name . value) ...) |
\((project_name . value) (project_name . value) ...) |
213 |
As always, the values of the project file are defined through properties.") |
As always, the values of the project file are defined through properties.") |
214 |
|
|
215 |
|
|
216 |
|
;; ----- Identlist manipulation ------------------------------------------- |
217 |
|
;; An identlist is a vector that is used internally to reference an identifier |
218 |
|
;; To facilitate its use, we provide the following macros |
219 |
|
|
220 |
|
(defmacro ada-make-identlist () (make-vector 8 nil)) |
221 |
|
(defmacro ada-name-of (identlist) (list 'aref identlist 0)) |
222 |
|
(defmacro ada-line-of (identlist) (list 'aref identlist 1)) |
223 |
|
(defmacro ada-column-of (identlist) (list 'aref identlist 2)) |
224 |
|
(defmacro ada-file-of (identlist) (list 'aref identlist 3)) |
225 |
|
(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4)) |
226 |
|
(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5)) |
227 |
|
(defmacro ada-references-of (identlist) (list 'aref identlist 6)) |
228 |
|
(defmacro ada-on-declaration (identlist) (list 'aref identlist 7)) |
229 |
|
|
230 |
|
(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name)) |
231 |
|
(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line)) |
232 |
|
(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col)) |
233 |
|
(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file)) |
234 |
|
(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index)) |
235 |
|
(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file)) |
236 |
|
(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref)) |
237 |
|
(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) |
238 |
|
|
239 |
|
(defsubst ada-get-ali-buffer (file) |
240 |
|
"Reads the ali file into a new buffer, and returns this buffer's name" |
241 |
|
(find-file-noselect (ada-get-ali-file-name file))) |
242 |
|
|
243 |
|
|
244 |
|
;; ----------------------------------------------------------------------- |
245 |
|
|
246 |
(defun ada-quote-cmd (cmd) |
(defun ada-quote-cmd (cmd) |
247 |
"Duplicates all \\ characters in CMD so that it can be passed to `compile'" |
"Duplicates all \\ characters in CMD so that it can be passed to `compile'" |
248 |
(mapconcat 'identity (split-string cmd "\\\\") "\\\\")) |
(mapconcat 'identity (split-string cmd "\\\\") "\\\\")) |
261 |
;; Even if we get an error, delete the *gnatls* buffer |
;; Even if we get an error, delete the *gnatls* buffer |
262 |
(unwind-protect |
(unwind-protect |
263 |
(progn |
(progn |
264 |
(call-process (concat cross-prefix "gnatls") |
(apply 'call-process (concat cross-prefix "gnatls") |
265 |
nil t nil "-v") |
(append '(nil t nil) ada-gnatls-args)) |
266 |
(goto-char (point-min)) |
(goto-char (point-min)) |
267 |
|
|
268 |
;; Source path |
;; Source path |
271 |
(forward-line 1) |
(forward-line 1) |
272 |
(while (not (looking-at "^$")) |
(while (not (looking-at "^$")) |
273 |
(back-to-indentation) |
(back-to-indentation) |
274 |
(unless (looking-at "<Current_Directory>") |
(if (looking-at "<Current_Directory>") |
275 |
|
(add-to-list 'ada-xref-runtime-library-specs-path ".") |
276 |
(add-to-list 'ada-xref-runtime-library-specs-path |
(add-to-list 'ada-xref-runtime-library-specs-path |
277 |
(buffer-substring-no-properties |
(buffer-substring-no-properties |
278 |
(point) |
(point) |
285 |
(forward-line 1) |
(forward-line 1) |
286 |
(while (not (looking-at "^$")) |
(while (not (looking-at "^$")) |
287 |
(back-to-indentation) |
(back-to-indentation) |
288 |
(unless (looking-at "<Current_Directory>") |
(if (looking-at "<Current_Directory>") |
289 |
|
(add-to-list 'ada-xref-runtime-library-ali-path ".") |
290 |
(add-to-list 'ada-xref-runtime-library-ali-path |
(add-to-list 'ada-xref-runtime-library-ali-path |
291 |
(buffer-substring-no-properties |
(buffer-substring-no-properties |
292 |
(point) |
(point) |
355 |
(cond |
(cond |
356 |
(ada-prj-default-project-file |
(ada-prj-default-project-file |
357 |
ada-prj-default-project-file) |
ada-prj-default-project-file) |
358 |
(file |
(file (ada-prj-find-prj-file file t)) |
|
(ada-prj-get-prj-dir file)) |
|
359 |
(t |
(t |
360 |
(message (concat "Not editing an Ada file," |
(message (concat "Not editing an Ada file," |
361 |
"and no default project " |
"and no default project " |
475 |
|
|
476 |
(defun ada-xref-update-project-menu () |
(defun ada-xref-update-project-menu () |
477 |
"Update the menu Ada->Project, with the list of available project files." |
"Update the menu Ada->Project, with the list of available project files." |
|
(interactive) |
|
478 |
(let (submenu) |
(let (submenu) |
479 |
|
|
480 |
;; Create the standard items |
;; Create the standard items |
516 |
(or ada-xref-project-files '(nil))) |
(or ada-xref-project-files '(nil))) |
517 |
|
|
518 |
(if (not ada-xemacs) |
(if (not ada-xemacs) |
519 |
(if (and (lookup-key ada-mode-map [menu-bar Ada]) |
(if (lookup-key ada-mode-map [menu-bar Ada Project]) |
520 |
(lookup-key ada-mode-map [menu-bar Ada Project])) |
(setcdr (lookup-key ada-mode-map [menu-bar Ada Project]) |
521 |
(setcdr (lookup-key ada-mode-map [menu-bar Ada Project]) |
submenu))) |
522 |
submenu) |
)) |
|
(if (lookup-key ada-mode-map [menu-bar ada Project]) |
|
|
(setcdr (lookup-key ada-mode-map [menu-bar ada Project]) |
|
|
submenu)))) |
|
|
)) |
|
523 |
|
|
524 |
|
|
525 |
;;------------------------------------------------------------- |
;;------------------------------------------------------------- |
565 |
(error (concat filename " not found in src_dir"))))) |
(error (concat filename " not found in src_dir"))))) |
566 |
|
|
567 |
|
|
|
;; ----- Keybindings ------------------------------------------------------ |
|
|
|
|
|
(defun ada-add-keymap () |
|
|
"Add new key bindings when using `ada-xrel.el'." |
|
|
(interactive) |
|
|
(if ada-xemacs |
|
|
(progn |
|
|
(define-key ada-mode-map '(shift button3) 'ada-point-and-xref) |
|
|
(define-key ada-mode-map '(control tab) 'ada-complete-identifier)) |
|
|
(define-key ada-mode-map [C-tab] 'ada-complete-identifier) |
|
|
(define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref)) |
|
|
|
|
|
(define-key ada-mode-map "\C-co" 'ff-find-other-file) |
|
|
(define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame) |
|
|
(define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration) |
|
|
(define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) |
|
|
(define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) |
|
|
(define-key ada-mode-map "\C-cc" 'ada-change-prj) |
|
|
(define-key ada-mode-map "\C-cd" 'ada-set-default-project-file) |
|
|
(define-key ada-mode-map "\C-cg" 'ada-gdb-application) |
|
|
(define-key ada-mode-map "\C-cr" 'ada-run-application) |
|
|
(define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) |
|
|
(define-key ada-mode-map "\C-c\C-r" 'ada-find-references) |
|
|
(define-key ada-mode-map "\C-cl" 'ada-find-local-references) |
|
|
(define-key ada-mode-map "\C-c\C-v" 'ada-check-current) |
|
|
(define-key ada-mode-map "\C-cf" 'ada-find-file) |
|
|
) |
|
|
|
|
|
;; ----- Menus -------------------------------------------------------------- |
|
|
(defun ada-add-ada-menu () |
|
|
"Add some items to the standard Ada mode menu. |
|
|
The items are added to the menu called NAME, which should be the same |
|
|
name as was passed to `ada-create-menu'." |
|
|
(interactive) |
|
|
(if ada-xemacs |
|
|
(let* ((menu-list '("Ada")) |
|
|
(goto-menu '("Ada" "Goto")) |
|
|
(edit-menu '("Ada" "Edit")) |
|
|
(help-menu '("Ada" "Help")) |
|
|
(options-menu (list "Ada" "Options"))) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
menu-list ["Check file" ada-check-current |
|
|
(string= mode-name "Ada")] "Goto") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
menu-list ["Compile file" ada-compile-current |
|
|
(string= mode-name "Ada")] "Goto") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
menu-list ["Build" ada-compile-application t] "Goto") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
menu-list ["Run" ada-run-application t] "Goto") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
menu-list ["Debug" ada-gdb-application t] "Goto") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
menu-list ["--" nil t] "Goto") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["Goto Parent Unit" ada-goto-parent t] |
|
|
"Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["Goto References to any entity" |
|
|
ada-find-any-references t] |
|
|
"Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["List References" ada-find-references t] |
|
|
"Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["List Local References" ada-find-local-references t] |
|
|
"Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["Goto Declaration Other Frame" |
|
|
ada-goto-declaration-other-frame t] |
|
|
"Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["Goto Declaration/Body" |
|
|
ada-goto-declaration t] |
|
|
"Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["Goto Previous Reference" |
|
|
ada-xref-goto-previous-reference t] |
|
|
"Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
goto-menu ["--" nil t] "Next compilation error") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
edit-menu ["Complete Identifier" |
|
|
ada-complete-identifier t] |
|
|
"Indent Line") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
edit-menu ["--------" nil t] "Indent Line") |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
help-menu ["Gnat User Guide" (info "gnat_ug")]) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
help-menu ["Gnat Reference Manual" (info "gnat_rm")]) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
help-menu ["Gcc Documentation" (info "gcc")]) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
help-menu ["Gdb Documentation" (info "gdb")]) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
help-menu ["Ada95 Reference Manual" (info "arm95")]) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
options-menu |
|
|
["Show Cross-References in Other Buffer" |
|
|
(setq ada-xref-other-buffer |
|
|
(not ada-xref-other-buffer)) |
|
|
:style toggle :selected ada-xref-other-buffer]) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
options-menu |
|
|
["Automatically Recompile for Cross-References" |
|
|
(setq ada-xref-create-ali (not ada-xref-create-ali)) |
|
|
:style toggle :selected ada-xref-create-ali]) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
options-menu |
|
|
["Confirm Commands" |
|
|
(setq ada-xref-confirm-compile |
|
|
(not ada-xref-confirm-compile)) |
|
|
:style toggle :selected ada-xref-confirm-compile]) |
|
|
(if (string-match "gvd" ada-prj-default-debugger) |
|
|
(funcall (symbol-function 'add-menu-button) |
|
|
options-menu |
|
|
["Tight Integration With Gnu Visual Debugger" |
|
|
(setq ada-tight-gvd-integration |
|
|
(not ada-tight-gvd-integration)) |
|
|
:style toggle :selected ada-tight-gvd-integration])) |
|
|
) |
|
|
|
|
|
;; for Emacs |
|
|
(let* ((menu (or (lookup-key ada-mode-map [menu-bar Ada]) |
|
|
;; Emacs-21.4's easymenu.el downcases the events. |
|
|
(lookup-key ada-mode-map [menu-bar ada]))) |
|
|
(edit-menu (or (lookup-key menu [Edit]) (lookup-key menu [edit]))) |
|
|
(help-menu (or (lookup-key menu [Help]) (lookup-key menu [help]))) |
|
|
(goto-menu (or (lookup-key menu [Goto]) (lookup-key menu [goto]))) |
|
|
(options-menu (or (lookup-key menu [Options]) |
|
|
(lookup-key menu [options])))) |
|
|
|
|
|
(define-key-after menu [Check] '("Check file" . ada-check-current) |
|
|
'Customize) |
|
|
(define-key-after menu [Compile] '("Compile file" . ada-compile-current) |
|
|
'Check) |
|
|
(define-key-after menu [Build] '("Build" . ada-compile-application) |
|
|
'Compile) |
|
|
(define-key-after menu [Run] '("Run" . ada-run-application) 'Build) |
|
|
(define-key-after menu [Debug] '("Debug" . ada-gdb-application) 'Run) |
|
|
(define-key-after menu [rem] '("--" . nil) 'Debug) |
|
|
(define-key-after menu [Project] |
|
|
(cons "Project" (make-sparse-keymap)) 'rem) |
|
|
|
|
|
(define-key help-menu [Gnat_ug] |
|
|
'("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug")))) |
|
|
(define-key help-menu [Gnat_rm] |
|
|
'("Gnat Reference Manual" . (lambda() (interactive) (info "gnat_rm")))) |
|
|
(define-key help-menu [Gcc] |
|
|
'("Gcc Documentation" . (lambda() (interactive) (info "gcc")))) |
|
|
(define-key help-menu [gdb] |
|
|
'("Gdb Documentation" . (lambda() (interactive) (info "gdb")))) |
|
|
(define-key help-menu [arm95] |
|
|
'("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95")))) |
|
|
|
|
|
(define-key goto-menu [rem] '("----" . nil)) |
|
|
(define-key goto-menu [Parent] '("Goto Parent Unit" |
|
|
. ada-goto-parent)) |
|
|
(define-key goto-menu [References-any] |
|
|
'("Goto References to any entity" . ada-find-any-references)) |
|
|
(define-key goto-menu [References] |
|
|
'("List References" . ada-find-references)) |
|
|
(define-key goto-menu [Local-References] |
|
|
'("List Local References" . ada-find-local-references)) |
|
|
(define-key goto-menu [Prev] |
|
|
'("Goto Previous Reference" . ada-xref-goto-previous-reference)) |
|
|
(define-key goto-menu [Decl-other] |
|
|
'("Goto Declaration Other Frame" . ada-goto-declaration-other-frame)) |
|
|
(define-key goto-menu [Decl] |
|
|
'("Goto Declaration/Body" . ada-goto-declaration)) |
|
|
|
|
|
(define-key edit-menu [rem] '("----" . nil)) |
|
|
(define-key edit-menu [Complete] '("Complete Identifier" |
|
|
. ada-complete-identifier)) |
|
|
|
|
|
(define-key-after options-menu [xrefrecompile] |
|
|
'(menu-item "Automatically Recompile for Cross-References" |
|
|
(lambda()(interactive) |
|
|
(setq ada-xref-create-ali (not ada-xref-create-ali))) |
|
|
:button (:toggle . ada-xref-create-ali)) t) |
|
|
(define-key-after options-menu [xrefconfirm] |
|
|
'(menu-item "Confirm Commands" |
|
|
(lambda()(interactive) |
|
|
(setq ada-xref-confirm-compile |
|
|
(not ada-xref-confirm-compile))) |
|
|
:button (:toggle . ada-xref-confirm-compile)) t) |
|
|
(define-key-after options-menu [xrefother] |
|
|
'(menu-item "Show Cross-References in Other Buffer" |
|
|
(lambda()(interactive) |
|
|
(setq ada-xref-other-buffer (not ada-xref-other-buffer))) |
|
|
:button (:toggle . ada-xref-other-buffer)) t) |
|
|
|
|
|
(if (string-match "gvd" ada-prj-default-debugger) |
|
|
(define-key-after options-menu [tightgvd] |
|
|
'(menu-item "Tight Integration With Gnu Visual Debugger" |
|
|
(lambda()(interactive) |
|
|
(setq ada-tight-gvd-integration |
|
|
(not ada-tight-gvd-integration))) |
|
|
:button (:toggle . ada-tight-gvd-integration)) t)) |
|
|
|
|
|
(define-key edit-menu [rem3] '("------------" . nil)) |
|
|
(define-key edit-menu [open-file-from-src-path] |
|
|
'("Search File on source path..." . ada-find-file)) |
|
|
) |
|
|
) |
|
|
(ada-xref-update-project-menu) |
|
|
) |
|
|
|
|
568 |
;; ----- Utilities ------------------------------------------------- |
;; ----- Utilities ------------------------------------------------- |
569 |
|
|
570 |
(defun ada-require-project-file () |
(defun ada-require-project-file () |
594 |
This is overriden on VMS to convert from VMS filenames to Unix filenames." |
This is overriden on VMS to convert from VMS filenames to Unix filenames." |
595 |
name) |
name) |
596 |
|
|
597 |
(defun ada-set-default-project-file (name) |
(defun ada-set-default-project-file (name &optional keep-existing) |
598 |
"Set the file whose name is NAME as the default project file." |
"Set the file whose name is NAME as the default project file. |
599 |
|
If KEEP-EXISTING is true and a project file has already been loaded, nothing |
600 |
|
is done. This is meant to be used from ada-mode-hook, for instance to force |
601 |
|
a project file unless the user has already loaded one." |
602 |
(interactive "fProject file:") |
(interactive "fProject file:") |
603 |
(setq ada-prj-default-project-file name) |
(if (or (not keep-existing) |
604 |
(ada-reread-prj-file name) |
(not ada-prj-default-project-file) |
605 |
) |
(equal ada-prj-default-project-file "")) |
606 |
|
(progn |
607 |
|
(setq ada-prj-default-project-file name) |
608 |
|
(ada-reread-prj-file name)))) |
609 |
|
|
610 |
;; ------ Handling the project file ----------------------------- |
;; ------ Handling the project file ----------------------------- |
611 |
|
|
612 |
(defun ada-prj-find-prj-file (&optional no-user-question) |
(defun ada-prj-find-prj-file (&optional file no-user-question) |
613 |
"Find the prj file associated with the current buffer. |
"Find the prj file associated with FILE (or the current buffer if nil). |
614 |
If NO-USER-QUESTION is non-nil, use a default file if not project file was |
If NO-USER-QUESTION is non-nil, use a default file if not project file was |
615 |
found, and do not ask the user. |
found, and do not ask the user. |
616 |
If the buffer is not an Ada buffer, associate it with the default project |
If the buffer is not an Ada buffer, associate it with the default project |
623 |
;; the current buffer is not a real file (for instance an emerge buffer) |
;; the current buffer is not a real file (for instance an emerge buffer) |
624 |
|
|
625 |
(if (or (not (string= mode-name "Ada")) |
(if (or (not (string= mode-name "Ada")) |
626 |
(not (buffer-file-name)) |
(not (buffer-file-name))) |
627 |
(and ada-prj-default-project-file |
|
628 |
(not (string= ada-prj-default-project-file "")))) |
(if (and ada-prj-default-project-file |
629 |
(set 'selected ada-prj-default-project-file) |
(not (string= ada-prj-default-project-file ""))) |
630 |
|
(setq selected ada-prj-default-project-file) |
631 |
|
(setq selected nil)) |
632 |
|
|
633 |
;; other cases: use a more complex algorithm |
;; other cases: use a more complex algorithm |
634 |
|
|
635 |
(let* ((current-file (buffer-file-name)) |
(let* ((current-file (or file (buffer-file-name))) |
636 |
(first-choice (concat |
(first-choice (concat |
637 |
(file-name-sans-extension current-file) |
(file-name-sans-extension current-file) |
638 |
ada-project-file-extension)) |
ada-project-file-extension)) |
672 |
counter |
counter |
673 |
(nth (1- counter) prj-files))) |
(nth (1- counter) prj-files))) |
674 |
(setq counter (1+ counter)) |
(setq counter (1+ counter)) |
675 |
|
|
676 |
))) ; end of with-output-to ... |
))) ; end of with-output-to ... |
677 |
(setq choice nil) |
(setq choice nil) |
678 |
(while (or |
(while (or |
696 |
(unless (string= ada-last-prj-file "") |
(unless (string= ada-last-prj-file "") |
697 |
(set 'selected ada-last-prj-file)))) |
(set 'selected ada-last-prj-file)))) |
698 |
))) |
))) |
699 |
selected |
|
700 |
|
(or selected "default.adp") |
701 |
)) |
)) |
702 |
|
|
703 |
|
|
710 |
(ada-buffer (current-buffer))) |
(ada-buffer (current-buffer))) |
711 |
(setq prj-file (expand-file-name prj-file)) |
(setq prj-file (expand-file-name prj-file)) |
712 |
|
|
713 |
|
;; Set the project file as the active one. |
714 |
|
(setq ada-prj-default-project-file prj-file) |
715 |
|
|
716 |
;; Initialize the project with the default values |
;; Initialize the project with the default values |
717 |
(ada-xref-set-default-prj-values 'project (current-buffer)) |
(ada-xref-set-default-prj-values 'project (current-buffer)) |
718 |
|
|
721 |
;; find-file anyway, since the speedbar frame is special and does not |
;; find-file anyway, since the speedbar frame is special and does not |
722 |
;; allow the selection of a file in it. |
;; allow the selection of a file in it. |
723 |
|
|
724 |
(let* ((buffer (run-hook-with-args-until-success |
(if (file-exists-p prj-file) |
725 |
'ada-load-project-hook prj-file))) |
(progn |
726 |
(unless buffer |
(let* ((buffer (run-hook-with-args-until-success |
727 |
|
'ada-load-project-hook prj-file))) |
728 |
|
(unless buffer |
729 |
(setq buffer (find-file-noselect prj-file nil))) |
(setq buffer (find-file-noselect prj-file nil))) |
730 |
(set-buffer buffer)) |
(set-buffer buffer)) |
731 |
|
|
781 |
(reverse run_cmd)))) |
(reverse run_cmd)))) |
782 |
(set 'project (plist-put project 'debug_post_cmd |
(set 'project (plist-put project 'debug_post_cmd |
783 |
(reverse debug_post_cmd))) |
(reverse debug_post_cmd))) |
784 |
(set 'project (plist-put project 'debug_pre_cmd |
(set 'project (plist-put project 'debug_pre_cmd |
785 |
(reverse debug_pre_cmd))) |
(reverse debug_pre_cmd))) |
786 |
|
|
787 |
|
;; Kill the project buffer |
788 |
|
(kill-buffer nil) |
789 |
|
(set-buffer ada-buffer) |
790 |
|
) |
791 |
|
|
792 |
|
;; Else the file wasn't readable (probably the default project). |
793 |
|
;; We initialize it with the current environment variables. |
794 |
|
;; We need to add the startup directory in front so that |
795 |
|
;; files locally redefined are properly found. We cannot |
796 |
|
;; add ".", which varies too much depending on what the |
797 |
|
;; current buffer is. |
798 |
|
(set 'project |
799 |
|
(plist-put project 'src_dir |
800 |
|
(append |
801 |
|
(list command-line-default-directory) |
802 |
|
(split-string (or (getenv "ADA_INCLUDE_PATH") "") ":") |
803 |
|
(list "." default-directory)))) |
804 |
|
(set 'project |
805 |
|
(plist-put project 'obj_dir |
806 |
|
(append |
807 |
|
(list command-line-default-directory) |
808 |
|
(split-string (or (getenv "ADA_OBJECTS_PATH") "") ":") |
809 |
|
(list "." default-directory)))) |
810 |
|
) |
811 |
|
|
812 |
|
|
813 |
;; Delete the default project file from the list, if it is there. |
;; Delete the default project file from the list, if it is there. |
814 |
;; Note that in that case, this default project is the only one in |
;; Note that in that case, this default project is the only one in |
821 |
(setcdr (assoc prj-file ada-xref-project-files) project) |
(setcdr (assoc prj-file ada-xref-project-files) project) |
822 |
(add-to-list 'ada-xref-project-files (cons prj-file project))) |
(add-to-list 'ada-xref-project-files (cons prj-file project))) |
823 |
|
|
|
;; Set the project file as the active one. |
|
|
(setq ada-prj-default-project-file prj-file) |
|
|
|
|
824 |
;; Sets up the compilation-search-path so that Emacs is able to |
;; Sets up the compilation-search-path so that Emacs is able to |
825 |
;; go to the source of the errors in a compilation buffer |
;; go to the source of the errors in a compilation buffer |
826 |
(setq compilation-search-path (ada-xref-get-src-dir-field)) |
(setq compilation-search-path (ada-xref-get-src-dir-field)) |
837 |
(append (mapcar 'directory-file-name compilation-search-path) |
(append (mapcar 'directory-file-name compilation-search-path) |
838 |
ada-search-directories)) |
ada-search-directories)) |
839 |
|
|
|
;; Kill the project buffer |
|
|
(kill-buffer nil) |
|
|
(set-buffer ada-buffer) |
|
|
|
|
840 |
(ada-xref-update-project-menu) |
(ada-xref-update-project-menu) |
841 |
) |
) |
842 |
|
|
941 |
|
|
942 |
(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file)) |
(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file)) |
943 |
|
|
|
;; ----- Identlist manipulation ------------------------------------------- |
|
|
;; An identlist is a vector that is used internally to reference an identifier |
|
|
;; To facilitate its use, we provide the following macros |
|
|
|
|
|
(defmacro ada-make-identlist () (make-vector 8 nil)) |
|
|
(defmacro ada-name-of (identlist) (list 'aref identlist 0)) |
|
|
(defmacro ada-line-of (identlist) (list 'aref identlist 1)) |
|
|
(defmacro ada-column-of (identlist) (list 'aref identlist 2)) |
|
|
(defmacro ada-file-of (identlist) (list 'aref identlist 3)) |
|
|
(defmacro ada-ali-index-of (identlist) (list 'aref identlist 4)) |
|
|
(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5)) |
|
|
(defmacro ada-references-of (identlist) (list 'aref identlist 6)) |
|
|
(defmacro ada-on-declaration (identlist) (list 'aref identlist 7)) |
|
|
|
|
|
(defmacro ada-set-name (identlist name) (list 'aset identlist 0 name)) |
|
|
(defmacro ada-set-line (identlist line) (list 'aset identlist 1 line)) |
|
|
(defmacro ada-set-column (identlist col) (list 'aset identlist 2 col)) |
|
|
(defmacro ada-set-file (identlist file) (list 'aset identlist 3 file)) |
|
|
(defmacro ada-set-ali-index (identlist index) (list 'aset identlist 4 index)) |
|
|
(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file)) |
|
|
(defmacro ada-set-references (identlist ref) (list 'aset identlist 6 ref)) |
|
|
(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) |
|
|
|
|
|
(defsubst ada-get-ali-buffer (file) |
|
|
"Reads the ali file into a new buffer, and returns this buffer's name" |
|
|
(find-file-noselect (ada-get-ali-file-name file))) |
|
|
|
|
|
|
|
|
|
|
944 |
;; ----- Identifier Completion -------------------------------------------- |
;; ----- Identifier Completion -------------------------------------------- |
945 |
(defun ada-complete-identifier (pos) |
(defun ada-complete-identifier (pos) |
946 |
"Tries to complete the identifier around POS. |
"Tries to complete the identifier around POS. |
983 |
;; ----- Cross-referencing ---------------------------------------- |
;; ----- Cross-referencing ---------------------------------------- |
984 |
|
|
985 |
(defun ada-point-and-xref () |
(defun ada-point-and-xref () |
986 |
"Calls `mouse-set-point' and then `ada-goto-declaration'." |
"Jump to the declaration of the entity below the cursor." |
987 |
(interactive) |
(interactive) |
988 |
(mouse-set-point last-input-event) |
(mouse-set-point last-input-event) |
989 |
(ada-goto-declaration (point))) |
(ada-goto-declaration (point))) |
990 |
|
|
991 |
|
(defun ada-point-and-xref-body () |
992 |
|
"Jump to the body of the entity under the cursor." |
993 |
|
(interactive) |
994 |
|
(mouse-set-point last-input-event) |
995 |
|
(ada-goto-body (point))) |
996 |
|
|
997 |
|
(defun ada-goto-body (pos &optional other-frame) |
998 |
|
"Display the body of the entity around POS. |
999 |
|
If the entity doesn't have a body, display its declaration. |
1000 |
|
As a side effect, the buffer for the declaration is also open." |
1001 |
|
(interactive "d") |
1002 |
|
(ada-goto-declaration pos other-frame) |
1003 |
|
|
1004 |
|
;; Temporarily force the display in the same buffer, since we |
1005 |
|
;; already changed previously |
1006 |
|
(let ((ada-xref-other-buffer nil)) |
1007 |
|
(ada-goto-declaration (point) nil))) |
1008 |
|
|
1009 |
(defun ada-goto-declaration (pos &optional other-frame) |
(defun ada-goto-declaration (pos &optional other-frame) |
1010 |
"Display the declaration of the identifier around POS. |
"Display the declaration of the identifier around POS. |
1011 |
The declaration is shown in another buffer if `ada-xref-other-buffer' is |
The declaration is shown in another buffer if `ada-xref-other-buffer' is |
1109 |
;; Insert newlines so as to separate the name of the commands to run |
;; Insert newlines so as to separate the name of the commands to run |
1110 |
;; and the output of the commands. this doesn't work with cmdproxy.exe, |
;; and the output of the commands. this doesn't work with cmdproxy.exe, |
1111 |
;; which gets confused by newline characters. |
;; which gets confused by newline characters. |
1112 |
(if (not (string-match "cmdproxy.exe" shell-file-name)) |
(if (not (string-match ".exe" shell-file-name)) |
1113 |
(setq cmd (concat cmd "\n\n"))) |
(setq cmd (concat cmd "\n\n"))) |
1114 |
|
|
1115 |
(compile (ada-quote-cmd cmd)))) |
(compile (ada-quote-cmd cmd)))) |
1142 |
;; Insert newlines so as to separate the name of the commands to run |
;; Insert newlines so as to separate the name of the commands to run |
1143 |
;; and the output of the commands. this doesn't work with cmdproxy.exe, |
;; and the output of the commands. this doesn't work with cmdproxy.exe, |
1144 |
;; which gets confused by newline characters. |
;; which gets confused by newline characters. |
1145 |
(if (not (string-match "cmdproxy.exe" shell-file-name)) |
(if (not (string-match ".exe" shell-file-name)) |
1146 |
(setq cmd (concat cmd "\n\n"))) |
(setq cmd (concat cmd "\n\n"))) |
1147 |
|
|
1148 |
(compile (ada-quote-cmd cmd)))) |
(compile (ada-quote-cmd cmd)))) |
1246 |
(if (or arg ada-xref-confirm-compile) |
(if (or arg ada-xref-confirm-compile) |
1247 |
(set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) |
(set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) |
1248 |
|
|
1249 |
(let (comint-exec |
(let ((old-comint-exec (symbol-function 'comint-exec)) |
1250 |
|
comint-exec |
1251 |
in-post-mode |
in-post-mode |
1252 |
gud-gdb-massage-args) |
gud-gdb-massage-args) |
1253 |
|
|
1262 |
(if post-cmd |
(if post-cmd |
1263 |
(set 'post-cmd (concat post-cmd "\n"))) |
(set 'post-cmd (concat post-cmd "\n"))) |
1264 |
|
|
1265 |
|
|
1266 |
;; Temporarily replaces the definition of `comint-exec' so that we |
;; Temporarily replaces the definition of `comint-exec' so that we |
1267 |
;; can execute commands before running gdb. |
;; can execute commands before running gdb. |
1268 |
|
(make-local-variable 'comint-exec) |
1269 |
(fset 'comint-exec |
(fset 'comint-exec |
1270 |
`(lambda (buffer name command startfile switches) |
`(lambda (buffer name command startfile switches) |
1271 |
(let (compilation-buffer-name-function) |
(let (compilation-buffer-name-function) |
1289 |
(funcall (symbol-function 'jdb) cmd) |
(funcall (symbol-function 'jdb) cmd) |
1290 |
(gdb cmd)) |
(gdb cmd)) |
1291 |
|
|
1292 |
|
;; Restore the standard fset command (or for instance C-U M-x shell |
1293 |
|
;; wouldn't work anymore |
1294 |
|
|
1295 |
|
(fset 'comint-exec old-comint-exec) |
1296 |
|
|
1297 |
;; Send post-commands to the debugger |
;; Send post-commands to the debugger |
1298 |
(process-send-string (get-buffer-process (current-buffer)) post-cmd) |
(process-send-string (get-buffer-process (current-buffer)) post-cmd) |
1299 |
|
|
1324 |
|
|
1325 |
;; Reread the location of the standard runtime library |
;; Reread the location of the standard runtime library |
1326 |
(ada-initialize-runtime-library |
(ada-initialize-runtime-library |
1327 |
(or (ada-xref-get-project-field 'cross-prefix) "")) |
(or (ada-xref-get-project-field 'cross_prefix) "")) |
1328 |
) |
) |
1329 |
|
|
1330 |
;; ------ Private routines |
;; ------ Private routines |
1639 |
(unless (re-search-forward (concat (ada-ali-index-of identlist) |
(unless (re-search-forward (concat (ada-ali-index-of identlist) |
1640 |
"|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*" |
"|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*" |
1641 |
(ada-line-of identlist) |
(ada-line-of identlist) |
1642 |
"[^etp]" |
"[^etpzkd<>=^]" |
1643 |
(ada-column-of identlist) "\\>") |
(ada-column-of identlist) "\\>") |
1644 |
nil t) |
nil t) |
1645 |
|
|
1745 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1746 |
(while (re-search-backward my-regexp nil t) |
(while (re-search-backward my-regexp nil t) |
1747 |
(save-excursion |
(save-excursion |
1748 |
(setq line-ali (count-lines 1 (point))) |
(set 'line-ali (count-lines 1 (point))) |
1749 |
(beginning-of-line) |
(beginning-of-line) |
1750 |
;; have a look at the line and column numbers |
;; have a look at the line and column numbers |
1751 |
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") |
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") |
1836 |
(set 'locations (list (list (match-string 1 ali-line) ;; line |
(set 'locations (list (list (match-string 1 ali-line) ;; line |
1837 |
(match-string 2 ali-line) ;; column |
(match-string 2 ali-line) ;; column |
1838 |
(ada-declare-file-of identlist)))) |
(ada-declare-file-of identlist)))) |
1839 |
(while (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line start) |
(while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" |
1840 |
|
ali-line start) |
1841 |
(setq line (match-string 1 ali-line) |
(setq line (match-string 1 ali-line) |
1842 |
col (match-string 2 ali-line) |
col (match-string 3 ali-line) |
1843 |
start (match-end 2)) |
start (match-end 3)) |
1844 |
|
|
1845 |
;; it there was a file number in the same line |
;; it there was a file number in the same line |
1846 |
(if (string-match (concat "\\([0-9]+\\)|\\([^|bc]+\\)?" |
(if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?" |
1847 |
(match-string 0 ali-line)) |
(match-string 0 ali-line)) |
1848 |
ali-line) |
ali-line) |
1849 |
(let ((file-number (match-string 1 ali-line))) |
(let ((file-number (match-string 1 ali-line))) |
2237 |
|
|
2238 |
;; Completion for file names in the mini buffer should ignore .ali files |
;; Completion for file names in the mini buffer should ignore .ali files |
2239 |
(add-to-list 'completion-ignored-extensions ".ali") |
(add-to-list 'completion-ignored-extensions ".ali") |
2240 |
|
|
2241 |
|
(ada-xref-update-project-menu) |
2242 |
) |
) |
2243 |
|
|
2244 |
|
|
2257 |
(if (ada-find-file-in-dir "ddd" exec-path) |
(if (ada-find-file-in-dir "ddd" exec-path) |
2258 |
(set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar")))) |
(set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar")))) |
2259 |
|
|
|
;; Set the keymap once and for all, so that the keys set by the user in his |
|
|
;; config file are not overwritten every time we open a new file. |
|
|
(ada-add-ada-menu) |
|
|
(ada-add-keymap) |
|
|
|
|
2260 |
(add-hook 'ada-mode-hook 'ada-xref-initialize) |
(add-hook 'ada-mode-hook 'ada-xref-initialize) |
2261 |
|
|
2262 |
;; Initializes the cross references to the runtime library |
;; Initializes the cross references to the runtime library |
2267 |
(append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path) |
(append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path) |
2268 |
ada-search-directories)) |
ada-search-directories)) |
2269 |
|
|
|
;; Make sure that the files are always associated with a project file. Since |
|
|
;; the project file has some fields that are used for the editor (like the |
|
|
;; casing exceptions), it has to be read before the user edits a file). |
|
|
;; (add-hook 'ada-mode-hook |
|
|
;; (lambda() |
|
|
;; (let ((file (ada-prj-find-prj-file t))) |
|
|
;; (if file (ada-reread-prj-file file))))) |
|
|
|
|
2270 |
(provide 'ada-xref) |
(provide 'ada-xref) |
2271 |
|
|
2272 |
;;; ada-xref.el ends here |
;;; ada-xref.el ends here |