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 |
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002 |
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$ |
;; Ada Core Technologies's version: Revision: 1.155.2.8 (GNAT 3.15) |
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. |
51 |
Otherwise create either a new buffer or a new frame." |
Otherwise create either a new buffer or a new frame." |
52 |
:type 'boolean :group 'ada) |
:type 'boolean :group 'ada) |
53 |
|
|
54 |
(defcustom ada-xref-create-ali t |
(defcustom ada-xref-create-ali nil |
55 |
"*If non-nil, run gcc whenever the cross-references are not up-to-date. |
"*If non-nil, run gcc whenever the cross-references are not up-to-date. |
56 |
If nil, the cross-reference mode will never run gcc." |
If nil, the cross-reference mode will never run gcc." |
57 |
:type 'boolean :group 'ada) |
:type 'boolean :group 'ada) |
91 |
:type 'string :group 'ada) |
:type 'string :group 'ada) |
92 |
|
|
93 |
(defcustom ada-prj-default-comp-cmd |
(defcustom ada-prj-default-comp-cmd |
94 |
"${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current}" |
(concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" |
95 |
|
" ${comp_opt}") |
96 |
"*Default command to be used to compile a single file. |
"*Default command to be used to compile a single file. |
97 |
Emacs will add the filename at the end of this command. This is the same |
Emacs will add the filename at the end of this command. This is the same |
98 |
syntax as in the project file." |
syntax as in the project file." |
133 |
"*If non-nil, a new Emacs frame will be swallowed in GVD when debugging. |
"*If non-nil, a new Emacs frame will be swallowed in GVD when debugging. |
134 |
If GVD is not the debugger used, nothing happens.") |
If GVD is not the debugger used, nothing happens.") |
135 |
|
|
136 |
|
(defcustom ada-xref-search-with-egrep t |
137 |
|
"*If non-nil, use egrep to find the possible declarations for an entity. |
138 |
|
This alternate method is used when the exact location was not found in the |
139 |
|
information provided by GNAT. However, it might be expensive if you have a lot |
140 |
|
of sources, since it will search in all the files in your project." |
141 |
|
:type 'boolean :group 'ada) |
142 |
|
|
143 |
|
(defvar ada-load-project-hook nil |
144 |
|
"Hook that is run when loading a project file. |
145 |
|
Each function in this hook takes one argument FILENAME, that is the name of |
146 |
|
the project file to load. |
147 |
|
This hook should be used to support new formats for the project files. |
148 |
|
|
149 |
|
If the function can load the file with the given filename, it should create a |
150 |
|
buffer that contains a conversion of the file to the standard format of the |
151 |
|
project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\" |
152 |
|
lines). It should return nil if it doesn't know how to convert that project |
153 |
|
file.") |
154 |
|
|
155 |
|
|
156 |
;; ------- Nothing to be modified by the user below this |
;; ------- Nothing to be modified by the user below this |
157 |
(defvar ada-last-prj-file "" |
(defvar ada-last-prj-file "" |
158 |
"Name of the last project file entered by the user.") |
"Name of the last project file entered by the user.") |
225 |
(goto-char (point-min)) |
(goto-char (point-min)) |
226 |
|
|
227 |
;; Source path |
;; Source path |
228 |
|
|
229 |
(search-forward "Source Search Path:") |
(search-forward "Source Search Path:") |
230 |
(forward-line 1) |
(forward-line 1) |
231 |
(while (not (looking-at "^$")) |
(while (not (looking-at "^$")) |
238 |
(forward-line 1)) |
(forward-line 1)) |
239 |
|
|
240 |
;; Object path |
;; Object path |
241 |
|
|
242 |
(search-forward "Object Search Path:") |
(search-forward "Object Search Path:") |
243 |
(forward-line 1) |
(forward-line 1) |
244 |
(while (not (looking-at "^$")) |
(while (not (looking-at "^$")) |
282 |
(if (null value) |
(if (null value) |
283 |
(if (not (setq value (getenv name))) |
(if (not (setq value (getenv name))) |
284 |
(message (concat "No environment variable " name " found")))) |
(message (concat "No environment variable " name " found")))) |
285 |
|
|
286 |
(cond |
(cond |
287 |
((null value) |
((null value) |
288 |
(setq cmd-string (replace-match "" t t cmd-string))) |
(setq cmd-string (replace-match "" t t cmd-string))) |
303 |
plist) |
plist) |
304 |
(save-excursion |
(save-excursion |
305 |
(set-buffer ada-buffer) |
(set-buffer ada-buffer) |
306 |
|
|
307 |
(set 'plist |
(set 'plist |
308 |
;; Try hard to find a default value for filename, so that the user |
;; Try hard to find a default value for filename, so that the user |
309 |
;; can edit his project file even if the current buffer is not an |
;; can edit his project file even if the current buffer is not an |
310 |
;; Ada file or not even associated with a file |
;; Ada file or not even associated with a file |
311 |
(list 'filename (expand-file-name |
(list 'filename (expand-file-name |
312 |
(cond |
(cond |
|
(file |
|
|
(ada-prj-get-prj-dir file)) |
|
313 |
(ada-prj-default-project-file |
(ada-prj-default-project-file |
314 |
ada-prj-default-project-file) |
ada-prj-default-project-file) |
315 |
|
(file |
316 |
|
(ada-prj-get-prj-dir file)) |
317 |
(t |
(t |
318 |
(message (concat "Not editing an Ada file," |
(message (concat "Not editing an Ada file," |
319 |
"and no default project " |
"and no default project " |
357 |
'debug_post_cmd (list nil))) |
'debug_post_cmd (list nil))) |
358 |
) |
) |
359 |
(set symbol plist))) |
(set symbol plist))) |
360 |
|
|
361 |
(defun ada-xref-get-project-field (field) |
(defun ada-xref-get-project-field (field) |
362 |
"Extract the value of FIELD from the current project file. |
"Extract the value of FIELD from the current project file. |
363 |
The project file must have been loaded first. |
The project file must have been loaded first. |
373 |
;; Get the project file (either the current one, or a default one) |
;; Get the project file (either the current one, or a default one) |
374 |
(setq file (or (assoc file-name ada-xref-project-files) |
(setq file (or (assoc file-name ada-xref-project-files) |
375 |
(assoc nil ada-xref-project-files))) |
(assoc nil ada-xref-project-files))) |
376 |
|
|
377 |
;; If the file was not found, use the default values |
;; If the file was not found, use the default values |
378 |
(if file |
(if file |
379 |
;; Get the value from the file |
;; Get the value from the file |
409 |
(append |
(append |
410 |
;; Add ${build_dir} in front of the path |
;; Add ${build_dir} in front of the path |
411 |
(list build-dir) |
(list build-dir) |
412 |
|
|
413 |
(ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) |
(ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir) |
414 |
build-dir) |
build-dir) |
415 |
|
|
416 |
;; Add the standard runtime at the end |
;; Add the standard runtime at the end |
417 |
ada-xref-runtime-library-specs-path))) |
ada-xref-runtime-library-specs-path))) |
418 |
|
|
424 |
(append |
(append |
425 |
;; Add ${build_dir} in front of the path |
;; Add ${build_dir} in front of the path |
426 |
(list build-dir) |
(list build-dir) |
427 |
|
|
428 |
(ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir) |
(ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir) |
429 |
build-dir) |
build-dir) |
430 |
|
|
431 |
;; Add the standard runtime at the end |
;; Add the standard runtime at the end |
432 |
ada-xref-runtime-library-ali-path))) |
ada-xref-runtime-library-ali-path))) |
433 |
|
|
442 |
(cons 'New (cons "New..." 'ada-prj-new)) |
(cons 'New (cons "New..." 'ada-prj-new)) |
443 |
(cons 'Edit (cons "Edit..." 'ada-prj-edit)) |
(cons 'Edit (cons "Edit..." 'ada-prj-edit)) |
444 |
(cons 'sep (cons "---" nil)))) |
(cons 'sep (cons "---" nil)))) |
445 |
|
|
446 |
;; Add the new items |
;; Add the new items |
447 |
(mapcar |
(mapcar |
448 |
(lambda (x) |
(lambda (x) |
457 |
(append submenu |
(append submenu |
458 |
(list (cons (intern name) |
(list (cons (intern name) |
459 |
(list |
(list |
460 |
'menu-item (file-name-sans-extension |
'menu-item |
461 |
(file-name-nondirectory name)) |
(if (string= (file-name-extension name) |
462 |
|
ada-project-file-extension) |
463 |
|
(file-name-sans-extension |
464 |
|
(file-name-nondirectory name)) |
465 |
|
(file-name-nondirectory name)) |
466 |
command |
command |
467 |
:button (cons |
:button (cons |
468 |
:toggle |
:toggle |
469 |
(equal ada-prj-default-project-file |
(equal ada-prj-default-project-file |
470 |
(car x)) |
(car x)) |
471 |
)))))))) |
)))))))) |
472 |
|
|
473 |
;; Parses all the known project files, and insert at least the default |
;; Parses all the known project files, and insert at least the default |
474 |
;; one (in case ada-xref-project-files is nil) |
;; one (in case ada-xref-project-files is nil) |
475 |
(or ada-xref-project-files '(nil))) |
(or ada-xref-project-files '(nil))) |
476 |
|
|
477 |
(if (not ada-xemacs) |
(if (not ada-xemacs) |
478 |
(if (lookup-key ada-mode-map [menu-bar Ada Project]) |
(if (and (lookup-key ada-mode-map [menu-bar Ada]) |
479 |
(setcdr (lookup-key ada-mode-map [menu-bar Ada Project]) |
(lookup-key ada-mode-map [menu-bar Ada Project])) |
480 |
submenu))) |
(setcdr (lookup-key ada-mode-map [menu-bar Ada Project]) |
481 |
)) |
submenu) |
482 |
|
(if (lookup-key ada-mode-map [menu-bar ada Project]) |
483 |
|
(setcdr (lookup-key ada-mode-map [menu-bar ada Project]) |
484 |
|
submenu)))) |
485 |
|
)) |
486 |
|
|
487 |
|
|
488 |
;;------------------------------------------------------------- |
;;------------------------------------------------------------- |
544 |
(define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame) |
(define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame) |
545 |
(define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration) |
(define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration) |
546 |
(define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) |
(define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference) |
|
(define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file) |
|
547 |
(define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) |
(define-key ada-mode-map "\C-c\C-c" 'ada-compile-application) |
548 |
(define-key ada-mode-map "\C-cc" 'ada-change-prj) |
(define-key ada-mode-map "\C-cc" 'ada-change-prj) |
549 |
(define-key ada-mode-map "\C-cd" 'ada-set-default-project-file) |
(define-key ada-mode-map "\C-cd" 'ada-set-default-project-file) |
551 |
(define-key ada-mode-map "\C-cr" 'ada-run-application) |
(define-key ada-mode-map "\C-cr" 'ada-run-application) |
552 |
(define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) |
(define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent) |
553 |
(define-key ada-mode-map "\C-c\C-r" 'ada-find-references) |
(define-key ada-mode-map "\C-c\C-r" 'ada-find-references) |
554 |
|
(define-key ada-mode-map "\C-cl" 'ada-find-local-references) |
555 |
(define-key ada-mode-map "\C-c\C-v" 'ada-check-current) |
(define-key ada-mode-map "\C-c\C-v" 'ada-check-current) |
556 |
(define-key ada-mode-map "\C-c\C-f" 'ada-find-file) |
(define-key ada-mode-map "\C-cf" 'ada-find-file) |
557 |
) |
) |
558 |
|
|
559 |
;; ----- Menus -------------------------------------------------------------- |
;; ----- Menus -------------------------------------------------------------- |
593 |
goto-menu ["List References" ada-find-references t] |
goto-menu ["List References" ada-find-references t] |
594 |
"Next compilation error") |
"Next compilation error") |
595 |
(funcall (symbol-function 'add-menu-button) |
(funcall (symbol-function 'add-menu-button) |
596 |
|
goto-menu ["List Local References" ada-find-local-references t] |
597 |
|
"Next compilation error") |
598 |
|
(funcall (symbol-function 'add-menu-button) |
599 |
goto-menu ["Goto Declaration Other Frame" |
goto-menu ["Goto Declaration Other Frame" |
600 |
ada-goto-declaration-other-frame t] |
ada-goto-declaration-other-frame t] |
601 |
"Next compilation error") |
"Next compilation error") |
650 |
(not ada-tight-gvd-integration)) |
(not ada-tight-gvd-integration)) |
651 |
:style toggle :selected ada-tight-gvd-integration])) |
:style toggle :selected ada-tight-gvd-integration])) |
652 |
) |
) |
653 |
|
|
654 |
;; for Emacs |
;; for Emacs |
655 |
(let* ((menu (lookup-key ada-mode-map [menu-bar ada])) |
(let* ((menu (or (lookup-key ada-mode-map [menu-bar Ada]) |
656 |
(edit-menu (lookup-key ada-mode-map [menu-bar ada edit])) |
;; Emacs-21.4's easymenu.el downcases the events. |
657 |
(help-menu (lookup-key ada-mode-map [menu-bar ada help])) |
(lookup-key ada-mode-map [menu-bar ada]))) |
658 |
(goto-menu (lookup-key ada-mode-map [menu-bar ada goto])) |
(edit-menu (or (lookup-key menu [Edit]) (lookup-key menu [edit]))) |
659 |
(options-menu (lookup-key ada-mode-map [menu-bar ada options]))) |
(help-menu (or (lookup-key menu [Help]) (lookup-key menu [help]))) |
660 |
|
(goto-menu (or (lookup-key menu [Goto]) (lookup-key menu [goto]))) |
661 |
|
(options-menu (or (lookup-key menu [Options]) |
662 |
|
(lookup-key menu [options])))) |
663 |
|
|
664 |
(define-key-after menu [Check] '("Check file" . ada-check-current) |
(define-key-after menu [Check] '("Check file" . ada-check-current) |
665 |
'Customize) |
'Customize) |
691 |
'("Goto References to any entity" . ada-find-any-references)) |
'("Goto References to any entity" . ada-find-any-references)) |
692 |
(define-key goto-menu [References] |
(define-key goto-menu [References] |
693 |
'("List References" . ada-find-references)) |
'("List References" . ada-find-references)) |
694 |
|
(define-key goto-menu [Local-References] |
695 |
|
'("List Local References" . ada-find-local-references)) |
696 |
(define-key goto-menu [Prev] |
(define-key goto-menu [Prev] |
697 |
'("Goto Previous Reference" . ada-xref-goto-previous-reference)) |
'("Goto Previous Reference" . ada-xref-goto-previous-reference)) |
698 |
(define-key goto-menu [Decl-other] |
(define-key goto-menu [Decl-other] |
699 |
'("Goto Declaration Other Frame" . ada-goto-declaration-other-frame)) |
'("Goto Declaration Other Frame" . ada-goto-declaration-other-frame)) |
700 |
(define-key goto-menu [Decl] |
(define-key goto-menu [Decl] |
701 |
'("Goto Declaration/Body" . ada-goto-declaration)) |
'("Goto Declaration/Body" . ada-goto-declaration)) |
702 |
|
|
703 |
(define-key edit-menu [rem] '("----" . nil)) |
(define-key edit-menu [rem] '("----" . nil)) |
704 |
(define-key edit-menu [Complete] '("Complete Identifier" |
(define-key edit-menu [Complete] '("Complete Identifier" |
705 |
. ada-complete-identifier)) |
. ada-complete-identifier)) |
729 |
(not ada-tight-gvd-integration))) |
(not ada-tight-gvd-integration))) |
730 |
:button (:toggle . ada-tight-gvd-integration)) t)) |
:button (:toggle . ada-tight-gvd-integration)) t)) |
731 |
|
|
732 |
(define-key ada-mode-map [menu-bar Ada Edit rem3] '("------------" . nil)) |
(define-key edit-menu [rem3] '("------------" . nil)) |
733 |
(define-key ada-mode-map [menu-bar Ada Edit open-file-from-src-path] |
(define-key edit-menu [open-file-from-src-path] |
734 |
'("Search File on source path..." . ada-find-file)) |
'("Search File on source path..." . ada-find-file)) |
735 |
) |
) |
736 |
) |
) |
745 |
(not ada-xref-project-files) |
(not ada-xref-project-files) |
746 |
(string= ada-prj-default-project-file "")) |
(string= ada-prj-default-project-file "")) |
747 |
(ada-reread-prj-file))) |
(ada-reread-prj-file))) |
748 |
|
|
749 |
(defun ada-xref-push-pos (filename position) |
(defun ada-xref-push-pos (filename position) |
750 |
"Push (FILENAME, POSITION) on the position ring for cross-references." |
"Push (FILENAME, POSITION) on the position ring for cross-references." |
751 |
(setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring)) |
(setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring)) |
769 |
(defun ada-set-default-project-file (name) |
(defun ada-set-default-project-file (name) |
770 |
"Set the file whose name is NAME as the default project file." |
"Set the file whose name is NAME as the default project file." |
771 |
(interactive "fProject file:") |
(interactive "fProject file:") |
772 |
(set 'ada-prj-default-project-file name) |
(setq ada-prj-default-project-file name) |
773 |
(ada-reread-prj-file name) |
(ada-reread-prj-file name) |
774 |
) |
) |
775 |
|
|
787 |
;; Use the active project file if there is one. |
;; Use the active project file if there is one. |
788 |
;; This is also valid if we don't currently have an Ada buffer, or if |
;; This is also valid if we don't currently have an Ada buffer, or if |
789 |
;; 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) |
790 |
|
|
791 |
(if (or (not (string= mode-name "Ada")) |
(if (or (not (string= mode-name "Ada")) |
792 |
(not (buffer-file-name)) |
(not (buffer-file-name)) |
793 |
(and ada-prj-default-project-file |
(and ada-prj-default-project-file |
794 |
(not (string= ada-prj-default-project-file "")))) |
(not (string= ada-prj-default-project-file "")))) |
795 |
(set 'selected ada-prj-default-project-file) |
(set 'selected ada-prj-default-project-file) |
796 |
|
|
797 |
;; other cases: use a more complex algorithm |
;; other cases: use a more complex algorithm |
798 |
|
|
799 |
(let* ((current-file (buffer-file-name)) |
(let* ((current-file (buffer-file-name)) |
800 |
(first-choice (concat |
(first-choice (concat |
801 |
(file-name-sans-extension current-file) |
(file-name-sans-extension current-file) |
802 |
ada-project-file-extension)) |
ada-project-file-extension)) |
803 |
(dir (file-name-directory current-file)) |
(dir (file-name-directory current-file)) |
804 |
|
|
805 |
;; on Emacs 20.2, directory-files does not work if |
;; on Emacs 20.2, directory-files does not work if |
806 |
;; parse-sexp-lookup-properties is set |
;; parse-sexp-lookup-properties is set |
807 |
(parse-sexp-lookup-properties nil) |
(parse-sexp-lookup-properties nil) |
810 |
(concat ".*" (regexp-quote |
(concat ".*" (regexp-quote |
811 |
ada-project-file-extension) "$"))) |
ada-project-file-extension) "$"))) |
812 |
(choice nil)) |
(choice nil)) |
813 |
|
|
814 |
(cond |
(cond |
815 |
|
|
816 |
;; Else if there is a project file with the same name as the Ada |
;; Else if there is a project file with the same name as the Ada |
817 |
;; file, but not the same extension. |
;; file, but not the same extension. |
818 |
((file-exists-p first-choice) |
((file-exists-p first-choice) |
819 |
(set 'selected first-choice)) |
(set 'selected first-choice)) |
820 |
|
|
821 |
;; Else if only one project file was found in the current directory |
;; Else if only one project file was found in the current directory |
822 |
((= (length prj-files) 1) |
((= (length prj-files) 1) |
823 |
(set 'selected (car prj-files))) |
(set 'selected (car prj-files))) |
824 |
|
|
825 |
;; Else if there are multiple files, ask the user |
;; Else if there are multiple files, ask the user |
826 |
((and (> (length prj-files) 1) (not no-user-question)) |
((and (> (length prj-files) 1) (not no-user-question)) |
827 |
(save-window-excursion |
(save-window-excursion |
846 |
(setq choice (string-to-int |
(setq choice (string-to-int |
847 |
(read-from-minibuffer "Enter No. of your choice: ")))) |
(read-from-minibuffer "Enter No. of your choice: ")))) |
848 |
(set 'selected (nth (1- choice) prj-files)))) |
(set 'selected (nth (1- choice) prj-files)))) |
849 |
|
|
850 |
;; Else if no project file was found in the directory, ask a name |
;; Else if no project file was found in the directory, ask a name |
851 |
;; to the user, using as a default value the last one entered by |
;; to the user, using as a default value the last one entered by |
852 |
;; the user |
;; the user |
880 |
;; find-file anyway, since the speedbar frame is special and does not |
;; find-file anyway, since the speedbar frame is special and does not |
881 |
;; allow the selection of a file in it. |
;; allow the selection of a file in it. |
882 |
|
|
883 |
(set-buffer (find-file-noselect prj-file)) |
(let* ((buffer (run-hook-with-args-until-success |
884 |
|
'ada-load-project-hook prj-file))) |
885 |
|
(unless buffer |
886 |
|
(setq buffer (find-file-noselect prj-file nil))) |
887 |
|
(set-buffer buffer)) |
888 |
|
|
889 |
(widen) |
(widen) |
890 |
(goto-char (point-min)) |
(goto-char (point-min)) |
891 |
|
|
921 |
(set 'project (plist-put project (intern (match-string 1)) |
(set 'project (plist-put project (intern (match-string 1)) |
922 |
(match-string 2)))))) |
(match-string 2)))))) |
923 |
(forward-line 1)) |
(forward-line 1)) |
924 |
|
|
925 |
(if src_dir (set 'project (plist-put project 'src_dir |
(if src_dir (set 'project (plist-put project 'src_dir |
926 |
(reverse src_dir)))) |
(reverse src_dir)))) |
927 |
(if obj_dir (set 'project (plist-put project 'obj_dir |
(if obj_dir (set 'project (plist-put project 'obj_dir |
946 |
;; the list |
;; the list |
947 |
(if (assoc nil ada-xref-project-files) |
(if (assoc nil ada-xref-project-files) |
948 |
(setq ada-xref-project-files nil)) |
(setq ada-xref-project-files nil)) |
949 |
|
|
950 |
;; Memorize the newly read project file |
;; Memorize the newly read project file |
951 |
(if (assoc prj-file ada-xref-project-files) |
(if (assoc prj-file ada-xref-project-files) |
952 |
(setcdr (assoc prj-file ada-xref-project-files) project) |
(setcdr (assoc prj-file ada-xref-project-files) project) |
954 |
|
|
955 |
;; Set the project file as the active one. |
;; Set the project file as the active one. |
956 |
(setq ada-prj-default-project-file prj-file) |
(setq ada-prj-default-project-file prj-file) |
957 |
|
|
958 |
;; Sets up the compilation-search-path so that Emacs is able to |
;; Sets up the compilation-search-path so that Emacs is able to |
959 |
;; go to the source of the errors in a compilation buffer |
;; go to the source of the errors in a compilation buffer |
960 |
(setq compilation-search-path (ada-xref-get-src-dir-field)) |
(setq compilation-search-path (ada-xref-get-src-dir-field)) |
964 |
(progn |
(progn |
965 |
(setq ada-case-exception-file (reverse casing)) |
(setq ada-case-exception-file (reverse casing)) |
966 |
(ada-case-read-exceptions))) |
(ada-case-read-exceptions))) |
967 |
|
|
968 |
;; Add the directories to the search path for ff-find-other-file |
;; Add the directories to the search path for ff-find-other-file |
969 |
;; Do not add the '/' or '\' at the end |
;; Do not add the '/' or '\' at the end |
970 |
(setq ada-search-directories |
(setq ada-search-directories |
971 |
(append (mapcar 'directory-file-name compilation-search-path) |
(append (mapcar 'directory-file-name compilation-search-path) |
972 |
ada-search-directories)) |
ada-search-directories)) |
973 |
|
|
974 |
;; Kill the .ali buffer |
;; Kill the project buffer |
975 |
(kill-buffer nil) |
(kill-buffer nil) |
976 |
(set-buffer ada-buffer) |
(set-buffer ada-buffer) |
977 |
|
|
985 |
;; directory. |
;; directory. |
986 |
(setq compilation-search-path (list nil default-directory)) |
(setq compilation-search-path (list nil default-directory)) |
987 |
)) |
)) |
988 |
|
|
989 |
|
|
990 |
(defun ada-find-references (&optional pos) |
(defun ada-find-references (&optional pos arg local-only) |
991 |
"Find all references to the entity under POS. |
"Find all references to the entity under POS. |
992 |
Calls gnatfind to find the references." |
Calls gnatfind to find the references. |
993 |
(interactive "") |
if ARG is t, the contents of the old *gnatfind* buffer is preserved. |
994 |
(unless pos |
if LOCAL-ONLY is t, only the declarations in the current file are returned." |
995 |
(set 'pos (point))) |
(interactive "d |
996 |
|
P") |
997 |
(ada-require-project-file) |
(ada-require-project-file) |
998 |
|
|
999 |
(let* ((identlist (ada-read-identifier pos)) |
(let* ((identlist (ada-read-identifier pos)) |
1007 |
(file-newer-than-file-p (ada-file-of identlist) alifile)) |
(file-newer-than-file-p (ada-file-of identlist) alifile)) |
1008 |
(ada-find-any-references (ada-name-of identlist) |
(ada-find-any-references (ada-name-of identlist) |
1009 |
(ada-file-of identlist) |
(ada-file-of identlist) |
1010 |
nil nil) |
nil nil local-only arg) |
1011 |
(ada-find-any-references (ada-name-of identlist) |
(ada-find-any-references (ada-name-of identlist) |
1012 |
(ada-file-of identlist) |
(ada-file-of identlist) |
1013 |
(ada-line-of identlist) |
(ada-line-of identlist) |
1014 |
(ada-column-of identlist)))) |
(ada-column-of identlist) local-only arg))) |
1015 |
) |
) |
1016 |
|
|
1017 |
(defun ada-find-any-references (entity &optional file line column) |
(defun ada-find-local-references (&optional pos arg) |
1018 |
|
"Find all references to the entity under POS. |
1019 |
|
Calls gnatfind to find the references. |
1020 |
|
if ARG is t, the contents of the old *gnatfind* buffer is preserved." |
1021 |
|
(interactive "d |
1022 |
|
P") |
1023 |
|
(ada-find-references pos arg t)) |
1024 |
|
|
1025 |
|
(defun ada-find-any-references |
1026 |
|
(entity &optional file line column local-only append) |
1027 |
"Search for references to any entity whose name is ENTITY. |
"Search for references to any entity whose name is ENTITY. |
1028 |
ENTITY was first found the location given by FILE, LINE and COLUMN." |
ENTITY was first found the location given by FILE, LINE and COLUMN. |
1029 |
|
If LOCAL-ONLY is t, then only the references in file will be listed, which |
1030 |
|
is much faster. |
1031 |
|
If APPEND is t, then the output of the command will be append to the existing |
1032 |
|
buffer *gnatfind* if it exists." |
1033 |
(interactive "sEntity name: ") |
(interactive "sEntity name: ") |
1034 |
(ada-require-project-file) |
(ada-require-project-file) |
1035 |
|
|
1047 |
quote-entity |
quote-entity |
1048 |
(if file (concat ":" (file-name-nondirectory file))) |
(if file (concat ":" (file-name-nondirectory file))) |
1049 |
(if line (concat ":" line)) |
(if line (concat ":" line)) |
1050 |
(if column (concat ":" column))))) |
(if column (concat ":" column)) |
1051 |
|
(if local-only (concat " " (file-name-nondirectory file))) |
1052 |
|
)) |
1053 |
|
old-contents) |
1054 |
|
|
1055 |
;; If a project file is defined, use it |
;; If a project file is defined, use it |
1056 |
(if (and ada-prj-default-project-file |
(if (and ada-prj-default-project-file |
1057 |
(not (string= ada-prj-default-project-file ""))) |
(not (string= ada-prj-default-project-file ""))) |
1058 |
(setq command (concat command " -p" ada-prj-default-project-file))) |
(setq command (concat command " -p" ada-prj-default-project-file))) |
1059 |
|
|
1060 |
|
(if (and append (get-buffer "*gnatfind*")) |
1061 |
|
(save-excursion |
1062 |
|
(set-buffer "*gnatfind*") |
1063 |
|
(setq old-contents (buffer-string)))) |
1064 |
|
|
1065 |
(compile-internal command "No more references" "gnatfind") |
(compile-internal command "No more references" "gnatfind") |
1066 |
|
|
1067 |
;; Hide the "Compilation" menu |
;; Hide the "Compilation" menu |
1068 |
(save-excursion |
(save-excursion |
1069 |
(set-buffer "*gnatfind*") |
(set-buffer "*gnatfind*") |
1070 |
(local-unset-key [menu-bar compilation-menu])) |
(local-unset-key [menu-bar compilation-menu]) |
1071 |
|
|
1072 |
|
(if old-contents |
1073 |
|
(progn |
1074 |
|
(goto-char 1) |
1075 |
|
(insert old-contents) |
1076 |
|
(goto-char (point-max))))) |
1077 |
) |
) |
1078 |
) |
) |
1079 |
|
|
1171 |
(let ((identlist (ada-read-identifier pos))) |
(let ((identlist (ada-read-identifier pos))) |
1172 |
(condition-case nil |
(condition-case nil |
1173 |
(ada-find-in-ali identlist other-frame) |
(ada-find-in-ali identlist other-frame) |
1174 |
(error (ada-find-in-src-path identlist other-frame))))) |
(error |
1175 |
|
(let ((ali-file (ada-get-ali-file-name (ada-file-of identlist)))) |
1176 |
|
|
1177 |
|
;; If the ALI file was up-to-date, then we probably have a predefined |
1178 |
|
;; entity, whose references are not given by GNAT |
1179 |
|
(if (and (file-exists-p ali-file) |
1180 |
|
(file-newer-than-file-p ali-file (ada-file-of identlist))) |
1181 |
|
(message "No cross-reference found. It might be a predefined entity.") |
1182 |
|
|
1183 |
|
;; Else, look in every ALI file, except if the user doesn't want that |
1184 |
|
(if ada-xref-search-with-egrep |
1185 |
|
(ada-find-in-src-path identlist other-frame) |
1186 |
|
(message "Cross-referencing information is not up-to-date. Please recompile.") |
1187 |
|
))))))) |
1188 |
|
|
1189 |
(defun ada-goto-declaration-other-frame (pos &optional other-frame) |
(defun ada-goto-declaration-other-frame (pos &optional other-frame) |
1190 |
"Display the declaration of the identifier around POS. |
"Display the declaration of the identifier around POS. |
1251 |
;; Make a single command from the list of commands, including the |
;; Make a single command from the list of commands, including the |
1252 |
;; commands to run it on a remote machine. |
;; commands to run it on a remote machine. |
1253 |
(setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) |
(setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) |
1254 |
|
|
1255 |
(if (or ada-xref-confirm-compile arg) |
(if (or ada-xref-confirm-compile arg) |
1256 |
(setq cmd (read-from-minibuffer "enter command to compile: " cmd))) |
(setq cmd (read-from-minibuffer "enter command to compile: " cmd))) |
1257 |
|
|
1260 |
;; which gets confused by newline characters. |
;; which gets confused by newline characters. |
1261 |
(if (not (string-match "cmdproxy.exe" shell-file-name)) |
(if (not (string-match "cmdproxy.exe" shell-file-name)) |
1262 |
(setq cmd (concat cmd "\n\n"))) |
(setq cmd (concat cmd "\n\n"))) |
1263 |
|
|
1264 |
(compile (ada-quote-cmd cmd)))) |
(compile (ada-quote-cmd cmd)))) |
1265 |
|
|
1266 |
(defun ada-compile-current (&optional arg prj-field) |
(defun ada-compile-current (&optional arg prj-field) |
1274 |
(cmd (ada-xref-get-project-field field)) |
(cmd (ada-xref-get-project-field field)) |
1275 |
(process-environment (ada-set-environment)) |
(process-environment (ada-set-environment)) |
1276 |
(compilation-scroll-output t)) |
(compilation-scroll-output t)) |
1277 |
|
|
1278 |
(setq compilation-search-path (ada-xref-get-src-dir-field)) |
(setq compilation-search-path (ada-xref-get-src-dir-field)) |
1279 |
|
|
1280 |
(unless cmd |
(unless cmd |
1281 |
(setq cmd '("") arg t)) |
(setq cmd '("") arg t)) |
1282 |
|
|
1283 |
;; Make a single command from the list of commands, including the |
;; Make a single command from the list of commands, including the |
1284 |
;; commands to run it on a remote machine. |
;; commands to run it on a remote machine. |
1285 |
(setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) |
(setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator))) |
1286 |
|
|
1287 |
;; If no project file was found, ask the user |
;; If no project file was found, ask the user |
1288 |
(if (or ada-xref-confirm-compile arg) |
(if (or ada-xref-confirm-compile arg) |
1289 |
(setq cmd (read-from-minibuffer "enter command to compile: " cmd))) |
(setq cmd (read-from-minibuffer "enter command to compile: " cmd))) |
1293 |
;; which gets confused by newline characters. |
;; which gets confused by newline characters. |
1294 |
(if (not (string-match "cmdproxy.exe" shell-file-name)) |
(if (not (string-match "cmdproxy.exe" shell-file-name)) |
1295 |
(setq cmd (concat cmd "\n\n"))) |
(setq cmd (concat cmd "\n\n"))) |
1296 |
|
|
1297 |
(compile (ada-quote-cmd cmd)))) |
(compile (ada-quote-cmd cmd)))) |
1298 |
|
|
1299 |
(defun ada-check-current (&optional arg) |
(defun ada-check-current (&optional arg) |
1321 |
;; Modify the command to run remotely |
;; Modify the command to run remotely |
1322 |
(setq command (ada-remote (mapconcat 'identity command |
(setq command (ada-remote (mapconcat 'identity command |
1323 |
ada-command-separator))) |
ada-command-separator))) |
1324 |
|
|
1325 |
;; Ask for the arguments to the command if required |
;; Ask for the arguments to the command if required |
1326 |
(if (or ada-xref-confirm-compile arg) |
(if (or ada-xref-confirm-compile arg) |
1327 |
(setq command (read-from-minibuffer "Enter command to execute: " |
(setq command (read-from-minibuffer "Enter command to execute: " |
1412 |
|
|
1413 |
;; Temporarily replaces the definition of `comint-exec' so that we |
;; Temporarily replaces the definition of `comint-exec' so that we |
1414 |
;; can execute commands before running gdb. |
;; can execute commands before running gdb. |
1415 |
(fset 'comint-exec |
(fset 'comint-exec |
1416 |
`(lambda (buffer name command startfile switches) |
`(lambda (buffer name command startfile switches) |
1417 |
(let (compilation-buffer-name-function) |
(let (compilation-buffer-name-function) |
1418 |
(save-excursion |
(save-excursion |
1429 |
ada-tight-gvd-integration |
ada-tight-gvd-integration |
1430 |
(not (string-match "--tty" cmd))) |
(not (string-match "--tty" cmd))) |
1431 |
(setq cmd (concat cmd "--tty"))) |
(setq cmd (concat cmd "--tty"))) |
1432 |
|
|
1433 |
(if (and (string-match "jdb" (comint-arguments cmd 0 0)) |
(if (and (string-match "jdb" (comint-arguments cmd 0 0)) |
1434 |
(boundp 'jdb)) |
(boundp 'jdb)) |
1435 |
(funcall (symbol-function 'jdb) cmd) |
(funcall (symbol-function 'jdb) cmd) |
1480 |
(if (and ali-file-name |
(if (and ali-file-name |
1481 |
(get-file-buffer ali-file-name)) |
(get-file-buffer ali-file-name)) |
1482 |
(kill-buffer (get-file-buffer ali-file-name))) |
(kill-buffer (get-file-buffer ali-file-name))) |
1483 |
|
|
1484 |
(let* ((name (ada-convert-file-name file)) |
(let* ((name (ada-convert-file-name file)) |
1485 |
(body-name (or (ada-get-body-name name) name))) |
(body-name (or (ada-get-body-name name) name))) |
1486 |
|
|
1516 |
(while (and (not found) dir-list) |
(while (and (not found) dir-list) |
1517 |
(set 'found (concat (file-name-as-directory (car dir-list)) |
(set 'found (concat (file-name-as-directory (car dir-list)) |
1518 |
(file-name-nondirectory file))) |
(file-name-nondirectory file))) |
1519 |
|
|
1520 |
(unless (file-exists-p found) |
(unless (file-exists-p found) |
1521 |
(set 'found nil)) |
(set 'found nil)) |
1522 |
(set 'dir-list (cdr dir-list))) |
(set 'dir-list (cdr dir-list))) |
1587 |
(file-name-nondirectory |
(file-name-nondirectory |
1588 |
(ada-other-file-name))) |
(ada-other-file-name))) |
1589 |
".ali")))) |
".ali")))) |
1590 |
|
|
1591 |
|
|
1592 |
(setq ali-file-name |
(setq ali-file-name |
1593 |
(or ali-file-name |
(or ali-file-name |
1594 |
|
|
1595 |
;; Else we take the .ali file associated with the unit |
;; Else we take the .ali file associated with the unit |
1596 |
(ada-find-ali-file-in-dir short-ali-file-name) |
(ada-find-ali-file-in-dir short-ali-file-name) |
1597 |
|
|
1598 |
|
|
1599 |
;; else we did not find the .ali file Second chance: in case |
;; else we did not find the .ali file Second chance: in case |
1600 |
;; the files do not have standard names (such as for instance |
;; the files do not have standard names (such as for instance |
1605 |
(file-name-nondirectory (ada-other-file-name))) |
(file-name-nondirectory (ada-other-file-name))) |
1606 |
".ali")) |
".ali")) |
1607 |
|
|
1608 |
|
|
1609 |
;; If we still don't have an ali file, try to get the one |
;; If we still don't have an ali file, try to get the one |
1610 |
;; from the parent unit, in case we have a separate entity. |
;; from the parent unit, in case we have a separate entity. |
1611 |
(let ((parent-name (file-name-sans-extension |
(let ((parent-name (file-name-sans-extension |
1612 |
(file-name-nondirectory file)))) |
(file-name-nondirectory file)))) |
1613 |
|
|
1614 |
(while (and (not ali-file-name) |
(while (and (not ali-file-name) |
1615 |
(string-match "^\\(.*\\)[.-][^.-]*" parent-name)) |
(string-match "^\\(.*\\)[.-][^.-]*" parent-name)) |
1616 |
|
|
1617 |
(set 'parent-name (match-string 1 parent-name)) |
(set 'parent-name (match-string 1 parent-name)) |
1618 |
(set 'ali-file-name (ada-find-ali-file-in-dir |
(set 'ali-file-name (ada-find-ali-file-in-dir |
1619 |
(concat parent-name ".ali"))) |
(concat parent-name ".ali"))) |
1620 |
) |
) |
1621 |
ali-file-name))) |
ali-file-name))) |
1622 |
|
|
1623 |
;; If still not found, try to recompile the file |
;; If still not found, try to recompile the file |
1624 |
(if (not ali-file-name) |
(if (not ali-file-name) |
1625 |
;; recompile only if the user asked for this. and search the ali |
;; recompile only if the user asked for this. and search the ali |
1626 |
;; filename again. We avoid a possible infinite recursion by |
;; filename again. We avoid a possible infinite recursion by |
1627 |
;; temporarily disabling the automatic compilation. |
;; temporarily disabling the automatic compilation. |
1628 |
|
|
1629 |
(if ada-xref-create-ali |
(if ada-xref-create-ali |
1630 |
(setq ali-file-name |
(setq ali-file-name |
1631 |
(concat (file-name-sans-extension (ada-xref-current file)) |
(concat (file-name-sans-extension (ada-xref-current file)) |
1632 |
".ali")) |
".ali")) |
1633 |
|
|
1634 |
(error "Ali file not found. Recompile your file")) |
(error "Ali file not found. Recompile your file")) |
1635 |
|
|
1636 |
|
|
1637 |
;; same if the .ali file is too old and we must recompile it |
;; same if the .ali file is too old and we must recompile it |
1638 |
(if (and (file-newer-than-file-p file ali-file-name) |
(if (and (file-newer-than-file-p file ali-file-name) |
1639 |
ada-xref-create-ali) |
ada-xref-create-ali) |
1657 |
(set-buffer buffer) |
(set-buffer buffer) |
1658 |
(find-file original-file) |
(find-file original-file) |
1659 |
(ada-require-project-file))) |
(ada-require-project-file))) |
1660 |
|
|
1661 |
;; we choose the first possible completion and we |
;; we choose the first possible completion and we |
1662 |
;; return the absolute file name |
;; return the absolute file name |
1663 |
(let ((filename (ada-find-src-file-in-dir file))) |
(let ((filename (ada-find-src-file-in-dir file))) |
1687 |
;; If at end of buffer (e.g the buffer is empty), error |
;; If at end of buffer (e.g the buffer is empty), error |
1688 |
(if (>= (point) (point-max)) |
(if (>= (point) (point-max)) |
1689 |
(error "No identifier on point")) |
(error "No identifier on point")) |
1690 |
|
|
1691 |
;; goto first character of the identifier/operator (skip backward < and > |
;; goto first character of the identifier/operator (skip backward < and > |
1692 |
;; since they are part of multiple character operators |
;; since they are part of multiple character operators |
1693 |
(goto-char pos) |
(goto-char pos) |
1724 |
(if (looking-at "[a-zA-Z0-9_]+") |
(if (looking-at "[a-zA-Z0-9_]+") |
1725 |
(set 'identifier (match-string 0)) |
(set 'identifier (match-string 0)) |
1726 |
(error "No identifier around"))) |
(error "No identifier around"))) |
1727 |
|
|
1728 |
;; Build the identlist |
;; Build the identlist |
1729 |
(set 'identlist (ada-make-identlist)) |
(set 'identlist (ada-make-identlist)) |
1730 |
(ada-set-name identlist (downcase identifier)) |
(ada-set-name identlist (downcase identifier)) |
1731 |
(ada-set-line identlist |
(ada-set-line identlist |
1732 |
(number-to-string (count-lines (point-min) (point)))) |
(number-to-string (count-lines 1 (point)))) |
1733 |
(ada-set-column identlist |
(ada-set-column identlist |
1734 |
(number-to-string (1+ (current-column)))) |
(number-to-string (1+ (current-column)))) |
1735 |
(ada-set-file identlist (buffer-file-name)) |
(ada-set-file identlist (buffer-file-name)) |
1739 |
(defun ada-get-all-references (identlist) |
(defun ada-get-all-references (identlist) |
1740 |
"Completes and returns IDENTLIST with the information extracted |
"Completes and returns IDENTLIST with the information extracted |
1741 |
from the ali file (definition file and places where it is referenced)." |
from the ali file (definition file and places where it is referenced)." |
1742 |
|
|
1743 |
(let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) |
(let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) |
1744 |
declaration-found) |
declaration-found) |
1745 |
(set-buffer ali-buffer) |
(set-buffer ali-buffer) |
1749 |
;; First attempt: we might already be on the declaration of the identifier |
;; First attempt: we might already be on the declaration of the identifier |
1750 |
;; We want to look for the declaration only in a definite interval (after |
;; We want to look for the declaration only in a definite interval (after |
1751 |
;; the "^X ..." line for the current file, and before the next "^X" line |
;; the "^X ..." line for the current file, and before the next "^X" line |
1752 |
|
|
1753 |
(if (re-search-forward |
(if (re-search-forward |
1754 |
(concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) |
(concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) |
1755 |
nil t) |
nil t) |
1759 |
(concat "^" (ada-line-of identlist) |
(concat "^" (ada-line-of identlist) |
1760 |
"." (ada-column-of identlist) |
"." (ada-column-of identlist) |
1761 |
"[ *]" (ada-name-of identlist) |
"[ *]" (ada-name-of identlist) |
1762 |
" \\(.*\\)$") bound t)) |
"[{\(<= ]?\\(.*\\)$") bound t)) |
1763 |
(if declaration-found |
(if declaration-found |
1764 |
(ada-set-on-declaration identlist t)) |
(ada-set-on-declaration identlist t)) |
1765 |
)) |
)) |
1768 |
;; have to fall back on other algorithms |
;; have to fall back on other algorithms |
1769 |
|
|
1770 |
(unless declaration-found |
(unless declaration-found |
1771 |
|
|
1772 |
;; Since we alread know the number of the file, search for a direct |
;; Since we alread know the number of the file, search for a direct |
1773 |
;; reference to it |
;; reference to it |
1774 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1778 |
(number-to-string (ada-find-file-number-in-ali |
(number-to-string (ada-find-file-number-in-ali |
1779 |
(ada-file-of identlist)))) |
(ada-file-of identlist)))) |
1780 |
(unless (re-search-forward (concat (ada-ali-index-of identlist) |
(unless (re-search-forward (concat (ada-ali-index-of identlist) |
1781 |
"|\\([0-9]+.[0-9]+ \\)*" |
"|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*" |
1782 |
(ada-line-of identlist) |
(ada-line-of identlist) |
1783 |
"[^0-9]" |
"[^etp]" |
1784 |
(ada-column-of identlist)) |
(ada-column-of identlist) "\\>") |
1785 |
nil t) |
nil t) |
1786 |
|
|
1787 |
;; if we did not find it, it may be because the first reference |
;; if we did not find it, it may be because the first reference |
1789 |
;; Or maybe we are already on the declaration... |
;; Or maybe we are already on the declaration... |
1790 |
(unless (re-search-forward |
(unless (re-search-forward |
1791 |
(concat |
(concat |
1792 |
"^\\(\\([a-zA-Z0-9_.]+\\|\"[<>=+*-/a-z]\"\\)[ *]\\)*" |
"^[0-9]+.[0-9]+[ *]" |
1793 |
|
(ada-name-of identlist) |
1794 |
|
"[ <{=\(]\\(.\\|\n\\.\\)*\\<" |
1795 |
(ada-line-of identlist) |
(ada-line-of identlist) |
1796 |
"[^0-9]" |
"[^0-9]" |
1797 |
(ada-column-of identlist)) |
(ada-column-of identlist) "\\>") |
1798 |
nil t) |
nil t) |
1799 |
|
|
1800 |
;; If still not found, then either the declaration is unknown |
;; If still not found, then either the declaration is unknown |
1801 |
;; or the source file has been modified since the ali file was |
;; or the source file has been modified since the ali file was |
1802 |
;; created |
;; created |
1813 |
(while (looking-at "^\\.") |
(while (looking-at "^\\.") |
1814 |
(previous-line 1)) |
(previous-line 1)) |
1815 |
(unless (looking-at (concat "[0-9]+.[0-9]+[ *]" |
(unless (looking-at (concat "[0-9]+.[0-9]+[ *]" |
1816 |
(ada-name-of identlist) "[ <]")) |
(ada-name-of identlist) "[ <{=\(]")) |
1817 |
(set 'declaration-found nil)))) |
(set 'declaration-found nil)))) |
1818 |
|
|
1819 |
;; Still no success ! The ali file must be too old, and we need to |
;; Still no success ! The ali file must be too old, and we need to |
1831 |
))) |
))) |
1832 |
) |
) |
1833 |
|
|
1834 |
|
|
1835 |
;; Now that we have found a suitable line in the .ali file, get the |
;; Now that we have found a suitable line in the .ali file, get the |
1836 |
;; information available |
;; information available |
1837 |
(beginning-of-line) |
(beginning-of-line) |
1854 |
identlist |
identlist |
1855 |
(ada-get-ada-file-name (match-string 1) |
(ada-get-ada-file-name (match-string 1) |
1856 |
(ada-file-of identlist))) |
(ada-file-of identlist))) |
1857 |
|
|
1858 |
;; Else clean up the ali file |
;; Else clean up the ali file |
1859 |
(error |
(error |
1860 |
(kill-buffer ali-buffer) |
(kill-buffer ali-buffer) |
1861 |
(error (error-message-string err))) |
(error (error-message-string err))) |
1862 |
)) |
)) |
1863 |
|
|
1864 |
(ada-set-references identlist current-line) |
(ada-set-references identlist current-line) |
1865 |
)) |
)) |
1866 |
)) |
)) |
1886 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1887 |
(while (re-search-backward my-regexp nil t) |
(while (re-search-backward my-regexp nil t) |
1888 |
(save-excursion |
(save-excursion |
1889 |
(set 'line-ali (count-lines (point-min) (point))) |
(setq line-ali (count-lines 1 (point))) |
1890 |
(beginning-of-line) |
(beginning-of-line) |
1891 |
;; have a look at the line and column numbers |
;; have a look at the line and column numbers |
1892 |
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") |
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") |
1913 |
(error (concat "No declaration of " |
(error (concat "No declaration of " |
1914 |
(ada-name-of identlist) |
(ada-name-of identlist) |
1915 |
" recorded in .ali file"))) |
" recorded in .ali file"))) |
1916 |
|
|
1917 |
;; one => should be the right one |
;; one => should be the right one |
1918 |
((= len 1) |
((= len 1) |
1919 |
(goto-line (caar declist))) |
(goto-line (caar declist))) |
1920 |
|
|
1921 |
;; more than one => display choice list |
;; more than one => display choice list |
1922 |
(t |
(t |
1923 |
(save-window-excursion |
(save-window-excursion |
1924 |
(with-output-to-temp-buffer "*choice list*" |
(with-output-to-temp-buffer "*choice list*" |
1925 |
|
|
1926 |
(princ "Identifier is overloaded and Xref information is not up to date.\n") |
(princ "Identifier is overloaded and Xref information is not up to date.\n") |
1927 |
(princ "Possible declarations are:\n\n") |
(princ "Possible declarations are:\n\n") |
1928 |
(princ " no. in file at line col\n") |
(princ " no. in file at line col\n") |
1994 |
) |
) |
1995 |
;; Else get the nearest file |
;; Else get the nearest file |
1996 |
(set 'file (ada-declare-file-of identlist))) |
(set 'file (ada-declare-file-of identlist))) |
1997 |
|
|
1998 |
(set 'locations (append locations (list (list line col file))))) |
(set 'locations (append locations (list (list line col file))))) |
1999 |
|
|
2000 |
;; Add the specs at the end again, so that from the last body we go to |
;; Add the specs at the end again, so that from the last body we go to |
2007 |
(setq line (caar locations) |
(setq line (caar locations) |
2008 |
col (nth 1 (car locations)) |
col (nth 1 (car locations)) |
2009 |
file (nth 2 (car locations))) |
file (nth 2 (car locations))) |
2010 |
|
|
2011 |
(while locations |
(while locations |
2012 |
(if (and (string= (caar locations) (ada-line-of identlist)) |
(if (and (string= (caar locations) (ada-line-of identlist)) |
2013 |
(string= (nth 1 (car locations)) (ada-column-of identlist)) |
(string= (nth 1 (car locations)) (ada-column-of identlist)) |
2046 |
This works well when one is using an external librarie and wants |
This works well when one is using an external librarie and wants |
2047 |
to find the declaration and documentation of the subprograms one is |
to find the declaration and documentation of the subprograms one is |
2048 |
is using." |
is using." |
2049 |
|
|
2050 |
(let (list |
(let (list |
2051 |
(dirs (ada-xref-get-obj-dir-field)) |
(dirs (ada-xref-get-obj-dir-field)) |
2052 |
(regexp (concat "[ *]" (ada-name-of identlist))) |
(regexp (concat "[ *]" (ada-name-of identlist))) |
2053 |
line column |
line column |
2054 |
choice |
choice |
2055 |
file) |
file) |
2056 |
|
|
2057 |
(save-excursion |
(save-excursion |
2058 |
|
|
2059 |
;; Do the grep in all the directories. We do multiple shell |
;; Do the grep in all the directories. We do multiple shell |
2060 |
;; commands instead of one in case there is no .ali file in one |
;; commands instead of one in case there is no .ali file in one |
2061 |
;; of the directory and the shell stops because of that. |
;; of the directory and the shell stops because of that. |
2062 |
|
|
2063 |
(set-buffer (get-buffer-create "*grep*")) |
(set-buffer (get-buffer-create "*grep*")) |
2064 |
(while dirs |
(while dirs |
2065 |
(insert (shell-command-to-string |
(insert (shell-command-to-string |
2066 |
(concat "egrep -i -h '^X|" regexp "( |$)' " |
(concat "egrep -i -h '^X|" regexp "( |$)' " |
2067 |
(file-name-as-directory (car dirs)) "*.ali"))) |
(file-name-as-directory (car dirs)) "*.ali"))) |
2068 |
(set 'dirs (cdr dirs))) |
(set 'dirs (cdr dirs))) |
2069 |
|
|
2070 |
;; Now parse the output |
;; Now parse the output |
2071 |
(set 'case-fold-search t) |
(set 'case-fold-search t) |
2072 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2080 |
column (match-string 2)) |
column (match-string 2)) |
2081 |
(re-search-backward "^X [0-9]+ \\(.*\\)$") |
(re-search-backward "^X [0-9]+ \\(.*\\)$") |
2082 |
(set 'file (list (match-string 1) line column)) |
(set 'file (list (match-string 1) line column)) |
2083 |
|
|
2084 |
;; There could be duplicate choices, because of the structure |
;; There could be duplicate choices, because of the structure |
2085 |
;; of the .ali files |
;; of the .ali files |
2086 |
(unless (member file list) |
(unless (member file list) |
2087 |
(set 'list (append list (list file)))))))) |
(set 'list (append list (list file)))))))) |
2088 |
|
|
2089 |
;; Current buffer is still "*grep*" |
;; Current buffer is still "*grep*" |
2090 |
(kill-buffer "*grep*") |
(kill-buffer "*grep*") |
2091 |
) |
) |
2092 |
|
|
2093 |
;; Now display the list of possible matches |
;; Now display the list of possible matches |
2094 |
(cond |
(cond |
2095 |
|
|
2096 |
;; No choice found => Error |
;; No choice found => Error |
2097 |
((null list) |
((null list) |
2098 |
(error "No cross-reference found, please recompile your file")) |
(error "No cross-reference found, please recompile your file")) |
2099 |
|
|
2100 |
;; Only one choice => Do the cross-reference |
;; Only one choice => Do the cross-reference |
2101 |
((= (length list) 1) |
((= (length list) 1) |
2102 |
(set 'file (ada-find-src-file-in-dir (caar list))) |
(set 'file (ada-find-src-file-in-dir (caar list))) |
2109 |
(error (concat (caar list) " not found in src_dir"))) |
(error (concat (caar list) " not found in src_dir"))) |
2110 |
(message "This is only a (good) guess at the cross-reference.") |
(message "This is only a (good) guess at the cross-reference.") |
2111 |
) |
) |
2112 |
|
|
2113 |
;; Else, ask the user |
;; Else, ask the user |
2114 |
(t |
(t |
2115 |
(save-window-excursion |
(save-window-excursion |
2116 |
(with-output-to-temp-buffer "*choice list*" |
(with-output-to-temp-buffer "*choice list*" |
2117 |
|
|
2118 |
(princ "Identifier is overloaded and Xref information is not up to date.\n") |
(princ "Identifier is overloaded and Xref information is not up to date.\n") |
2119 |
(princ "Possible declarations are:\n\n") |
(princ "Possible declarations are:\n\n") |
2120 |
(princ " no. in file at line col\n") |
(princ " no. in file at line col\n") |
2315 |
(progn |
(progn |
2316 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
2317 |
(kill-buffer (current-buffer)))) |
(kill-buffer (current-buffer)))) |
2318 |
|
|
2319 |
|
|
2320 |
;; Make sure the current buffer is the spec (this might not be the case |
;; Make sure the current buffer is the spec (this might not be the case |
2321 |
;; if for instance the user was asked for a project file) |
;; if for instance the user was asked for a project file) |
2375 |
;; This should really be an `add-hook'. -stef |
;; This should really be an `add-hook'. -stef |
2376 |
(setq ff-file-created-hooks 'ada-make-body-gnatstub) |
(setq ff-file-created-hooks 'ada-make-body-gnatstub) |
2377 |
|
|
|
;; Read the project file and update the search path |
|
|
;; before looking for the other file |
|
|
(make-local-hook 'ff-pre-find-hooks) |
|
|
(add-hook 'ff-pre-find-hooks 'ada-require-project-file nil t) |
|
|
|
|
2378 |
;; Completion for file names in the mini buffer should ignore .ali files |
;; Completion for file names in the mini buffer should ignore .ali files |
2379 |
(add-to-list 'completion-ignored-extensions ".ali") |
(add-to-list 'completion-ignored-extensions ".ali") |
2380 |
) |
) |
2413 |
;; Make sure that the files are always associated with a project file. Since |
;; Make sure that the files are always associated with a project file. Since |
2414 |
;; the project file has some fields that are used for the editor (like the |
;; the project file has some fields that are used for the editor (like the |
2415 |
;; casing exceptions), it has to be read before the user edits a file). |
;; casing exceptions), it has to be read before the user edits a file). |
2416 |
(add-hook 'ada-mode-hook |
;; (add-hook 'ada-mode-hook |
2417 |
(lambda() |
;; (lambda() |
2418 |
(let ((file (ada-prj-find-prj-file t))) |
;; (let ((file (ada-prj-find-prj-file t))) |
2419 |
(if file (ada-reread-prj-file file))))) |
;; (if file (ada-reread-prj-file file))))) |
2420 |
|
|
2421 |
(provide 'ada-xref) |
(provide 'ada-xref) |
2422 |
|
|