1 ;; Ada mode cross-reference functionality provided by the 'gnat xref'
2 ;; tool. Includes related functions, such as gnatprep support.
4 ;; These tools are all Ada-specific; see gpr-query or gnat-inspect for
5 ;; multi-language GNAT cross-reference tools.
7 ;; GNAT is provided by AdaCore; see http://libre.adacore.com/
9 ;;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
11 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
12 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
14 ;; This file is part of GNU Emacs.
16 ;; GNU Emacs is free software: you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
21 ;; GNU Emacs is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
31 ;; Emacs should enter Ada mode automatically when you load an Ada
32 ;; file, based on the file extension.
34 ;; By default, ada-mode is configured to load this file, so nothing
35 ;; special needs to done to use it.
37 (require 'ada-fix-error)
43 ;;;; uses of gnat tools
45 (defconst ada-gnat-file-line-col-regexp "\\(.*\\):\\([0-9]+\\):\\([0-9]+\\)")
47 (defun ada-gnat-xref-other (identifier file line col)
48 "For `ada-xref-other-function', using 'gnat find', which is Ada-specific."
50 (when (eq ?\" (aref identifier 0))
51 ;; gnat find wants the quotes on operators, but the column is after the first quote.
55 (let* ((file-non-dir (file-name-nondirectory file))
56 (arg (format "%s:%s:%d:%d" identifier file-non-dir line col))
59 (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get 'gpr_ext)))))
62 (with-current-buffer (gnat-run-buffer)
63 (gnat-run-gnat "find" (list switches arg))
65 (goto-char (point-min))
66 (forward-line 2); skip ADA_PROJECT_PATH, 'gnat find'
68 ;; gnat find returns two items; the starting point, and the 'other' point
69 (unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
71 (error "'%s' not found in cross-reference files; recompile?" identifier))
74 (looking-at (concat ada-gnat-file-line-col-regexp "\\(: warning:\\)?"))
76 ;; error in *.gpr; ignore here.
79 (let ((found-file (match-string 1))
80 (found-line (string-to-number (match-string 2)))
81 (found-col (string-to-number (match-string 3))))
84 (equal file-non-dir found-file)
88 (setq result (list found-file found-line (1- found-col)))
93 (pop-to-buffer (current-buffer))
94 (error "gnat find did not return other item"))
98 (defun ada-gnat-xref-parents (identifier file line col)
99 "For `ada-xref-parents-function', using 'gnat find', which is Ada-specific."
101 (let* ((arg (format "%s:%s:%d:%d" identifier file line col))
105 (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get 'gpr_ext)))
108 (with-current-buffer (gnat-run-buffer)
109 (gnat-run-gnat "find" (append switches (list arg)))
111 (goto-char (point-min))
112 (forward-line 2); skip GPR_PROJECT_PATH, 'gnat find'
114 ;; gnat find returns two items; the starting point, and the 'other' point
115 (unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
117 (error "'%s' not found in cross-reference files; recompile?" identifier))
120 (looking-at (concat ada-gnat-file-line-col-regexp "\\(: warning:\\)?"))
122 ;; error in *.gpr; ignore here.
125 (let ((found-file (match-string 1))
126 (found-line (string-to-number (match-string 2)))
127 (found-col (string-to-number (match-string 3))))
129 (skip-syntax-forward "^ ")
130 (skip-syntax-forward " ")
131 (if (looking-at (concat "derived from .* (" ada-gnat-file-line-col-regexp ")"))
133 (setq result (list (match-string 1)
134 (string-to-number (match-string 2))
135 (1- (string-to-number (match-string 3)))))
139 (pop-to-buffer (current-buffer))
140 (error "gnat find did not return parent types"))
143 (ada-goto-source (nth 0 result)
150 (defun ada-gnat-xref-all (identifier file line col)
151 "For `ada-xref-all-function'."
152 ;; we use `compilation-start' to run gnat, not `gnat-run', so it
153 ;; is asynchronous, and automatically runs the compilation error
156 (let* ((cmd (format "gnat find -a -r %s:%s:%d:%d" identifier file line col)))
158 (with-current-buffer (gnat-run-buffer); for default-directory
159 (let ((compilation-environment (ada-prj-get 'proc_env))
160 (compilation-error "reference")
161 ;; gnat find uses standard gnu format for output, so don't
162 ;; need to set compilation-error-regexp-alist
164 (when (ada-prj-get 'gpr_file)
165 (setq cmd (concat cmd " -P" (file-name-nondirectory (ada-prj-get 'gpr_file)))))
167 (compilation-start cmd
169 (lambda (mode-name) (concat mode-name "-gnatfind")))
174 (defun ada-gnat-xref-select-prj ()
175 (setq ada-file-name-from-ada-name 'ada-gnat-file-name-from-ada-name)
176 (setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
177 (setq ada-make-package-body 'ada-gnat-make-package-body)
179 (add-hook 'ada-syntax-propertize-hook 'gnatprep-syntax-propertize)
180 (add-hook 'ada-syntax-propertize-hook 'ada-gnat-syntax-propertize)
182 ;; must be after indentation engine setup, because that resets the
183 ;; indent function list.
184 (add-hook 'ada-mode-hook 'ada-gnat-xref-setup t)
186 (setq ada-xref-other-function 'ada-gnat-xref-other)
187 (setq ada-xref-parent-function 'ada-gnat-xref-parents)
188 (setq ada-xref-all-function 'ada-gnat-xref-all)
190 ;; gnatmake -gnatD generates files with .dg extensions. But we don't
191 ;; need to navigate between them.
193 ;; There is no common convention for a file extension for gnatprep files.
195 (add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files, used for cross reference
196 (add-to-list 'compilation-error-regexp-alist 'gnat)
199 (defun ada-gnat-xref-deselect-prj ()
200 (setq ada-file-name-from-ada-name nil)
201 (setq ada-ada-name-from-file-name nil)
202 (setq ada-make-package-body nil)
204 (setq ada-syntax-propertize-hook (delq 'gnatprep-syntax-propertize ada-syntax-propertize-hook))
205 (setq ada-mode-hook (delq 'ada-gnat-xref-setup ada-mode-hook))
207 (setq ada-xref-other-function nil)
208 (setq ada-xref-parent-function nil)
209 (setq ada-xref-all-function nil)
211 (setq completion-ignored-extensions (delete ".ali" completion-ignored-extensions))
212 (setq compilation-error-regexp-alist (delete 'gnat compilation-error-regexp-alist))
215 (defun ada-gnat-xref-setup ()
216 (when (boundp 'wisi-indent-calculate-functions)
217 (add-to-list 'wisi-indent-calculate-functions 'gnatprep-indent))
220 (defun ada-gnat-xref ()
221 "Set Ada mode global vars to use 'gnat xref'"
222 (add-to-list 'ada-prj-file-ext-extra "gpr")
223 (add-to-list 'ada-prj-parser-alist '("gpr" . gnat-parse-gpr))
224 (add-to-list 'ada-select-prj-xref-tool '(gnat . ada-gnat-xref-select-prj))
225 (add-to-list 'ada-deselect-prj-xref-tool '(gnat . ada-gnat-xref-deselect-prj))
227 ;; no parse-*-xref yet
229 (font-lock-add-keywords 'ada-mode
230 ;; gnatprep preprocessor line
231 (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-type-face t))))
233 (add-hook 'ada-gnat-fix-error-hook 'ada-gnat-fix-error))
237 (provide 'ada-gnat-xref)
238 (provide 'ada-xref-tool)
240 (unless (default-value 'ada-xref-tool)
241 (set-default 'ada-xref-tool 'gnat))