code.delx.au - gnu-emacs-elpa/blob - packages/ada-mode/ada-gnat-xref.el

   1 ;; Ada mode cross-reference functionality provided by the 'gnat xref'
   2 ;; tool. Includes related functions, such as gnatprep support.
   3 ;;
   4 ;; These tools are all Ada-specific; see gpr-query or gnat-inspect for
   5 ;; multi-language GNAT cross-reference tools.
   6 ;;
   7 ;; GNAT is provided by AdaCore; see http://libre.adacore.com/
   8 ;;
   9 ;;; Copyright (C) 2012 - 2014  Free Software Foundation, Inc.
  10 ;;
  11 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
  12 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
  13 ;;
  14 ;; This file is part of GNU Emacs.
  15 ;;
  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.
  20 ;;
  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.
  25 ;;
  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/>.
  28 ;;
  29 ;;; Usage:
  30 ;;
  31 ;; Emacs should enter Ada mode automatically when you load an Ada
  32 ;; file, based on the file extension.
  33 ;;
  34 ;; By default, ada-mode is configured to load this file, so nothing
  35 ;; special needs to done to use it.
  36
  37 (require 'ada-fix-error)
  38 (require 'compile)
  39 (require 'gnat-core)
  40
  41 ;;;;; code
  42
  43 ;;;; uses of gnat tools
  44
  45 (defconst ada-gnat-file-line-col-regexp "\\(.*\\):\\([0-9]+\\):\\([0-9]+\\)")
  46
  47 (defun ada-gnat-xref-other (identifier file line col)
  48   "For `ada-xref-other-function', using 'gnat find', which is Ada-specific."
  49
  50   (when (eq ?\" (aref identifier 0))
  51     ;; gnat find wants the quotes on operators, but the column is after the first quote.
  52     (setq col (+ 1 col))
  53     )
  54
  55   (let* ((file-non-dir (file-name-nondirectory file))
  56          (arg (format "%s:%s:%d:%d" identifier file-non-dir line col))
  57          (switches (concat
  58                     "-a"
  59                     (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get 'gpr_ext)))))
  60          status
  61          (result nil))
  62     (with-current-buffer (gnat-run-buffer)
  63       (gnat-run-gnat "find" (list switches arg))
  64
  65       (goto-char (point-min))
  66       (forward-line 2); skip ADA_PROJECT_PATH, 'gnat find'
  67
  68       ;; gnat find returns two items; the starting point, and the 'other' point
  69       (unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
  70         ;; no results
  71         (error "'%s' not found in cross-reference files; recompile?" identifier))
  72
  73       (while (not result)
  74         (looking-at (concat ada-gnat-file-line-col-regexp "\\(: warning:\\)?"))
  75         (if (match-string 4)
  76             ;; error in *.gpr; ignore here.
  77             (forward-line 1)
  78           ;; else process line
  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))))
  82             (if (not
  83                  (and
  84                   (equal file-non-dir found-file)
  85                   (= line found-line)
  86                   (= col found-col)))
  87                 ;; found other item
  88                 (setq result (list found-file found-line (1- found-col)))
  89               (forward-line 1))
  90             ))
  91
  92         (when (eobp)
  93           (error "gnat find did not return other item"))
  94         ))
  95     result))
  96
  97 (defun ada-gnat-xref-parents (identifier file line col)
  98   "For `ada-xref-parents-function', using 'gnat find', which is Ada-specific."
  99
 100   (let* ((arg (format "%s:%s:%d:%d" identifier file line col))
 101          (switches (list
 102                     "-a"
 103                     "-d"
 104                     (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get 'gpr_ext)))
 105                     ))
 106          (result nil))
 107     (with-current-buffer (gnat-run-buffer)
 108       (gnat-run-gnat "find" (append switches (list arg)))
 109
 110       (goto-char (point-min))
 111       (forward-line 2); skip GPR_PROJECT_PATH, 'gnat find'
 112
 113       ;; gnat find returns two items; the starting point, and the 'other' point
 114       (unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
 115         ;; no results
 116         (error "'%s' not found in cross-reference files; recompile?" identifier))
 117
 118       (while (not result)
 119         (looking-at (concat ada-gnat-file-line-col-regexp "\\(: warning:\\)?"))
 120         (if (match-string 4)
 121             ;; error in *.gpr; ignore here.
 122             (forward-line 1)
 123           ;; else process line
 124           (let ((found-file (match-string 1))
 125                 (found-line (string-to-number (match-string 2)))
 126                 (found-col  (string-to-number (match-string 3))))
 127
 128             (skip-syntax-forward "^ ")
 129             (skip-syntax-forward " ")
 130             (if (looking-at (concat "derived from .* (" ada-gnat-file-line-col-regexp ")"))
 131                 ;; found other item
 132                 (setq result (list (match-string 1)
 133                                    (string-to-number (match-string 2))
 134                                    (1- (string-to-number (match-string 3)))))
 135               (forward-line 1)))
 136           )
 137         (when (eobp)
 138           (error "gnat find did not return parent types"))
 139         ))
 140
 141     (ada-goto-source (nth 0 result)
 142                      (nth 1 result)
 143                      (nth 2 result)
 144                      nil ;; other-window
 145                      )
 146     ))
 147
 148 (defun ada-gnat-xref-all (identifier file line col)
 149   "For `ada-xref-all-function'."
 150   ;; we use `compilation-start' to run gnat, not `gnat-run', so it
 151   ;; is asynchronous, and automatically runs the compilation error
 152   ;; filter.
 153
 154   (let* ((cmd (format "gnat find -a -r %s:%s:%d:%d" identifier file line col)))
 155
 156     (with-current-buffer (gnat-run-buffer); for default-directory
 157       (let ((compilation-environment (ada-prj-get 'proc_env))
 158             (compilation-error "reference")
 159             ;; gnat find uses standard gnu format for output, so don't
 160             ;; need to set compilation-error-regexp-alist
 161             )
 162         (when (ada-prj-get 'gpr_file)
 163           (setq cmd (concat cmd " -P" (file-name-nondirectory (ada-prj-get 'gpr_file)))))
 164
 165         (compilation-start cmd
 166                            'compilation-mode
 167                            (lambda (mode-name) (concat mode-name "-gnatfind")))
 168     ))))
 169
 170 ;;;;; setup
 171
 172 (defun ada-gnat-xref-select-prj ()
 173   (setq ada-file-name-from-ada-name 'ada-gnat-file-name-from-ada-name)
 174   (setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
 175   (setq ada-make-package-body       'ada-gnat-make-package-body)
 176
 177   (add-hook 'ada-syntax-propertize-hook 'gnatprep-syntax-propertize)
 178   (add-hook 'ada-syntax-propertize-hook 'ada-gnat-syntax-propertize)
 179
 180   ;; must be after indentation engine setup, because that resets the
 181   ;; indent function list.
 182   (add-hook 'ada-mode-hook 'ada-gnat-xref-setup t)
 183
 184   (setq ada-xref-other-function  'ada-gnat-xref-other)
 185   (setq ada-xref-parent-function 'ada-gnat-xref-parents)
 186   (setq ada-xref-all-function    'ada-gnat-xref-all)
 187   (setq ada-show-xref-tool-buffer 'ada-gnat-show-run-buffer)
 188
 189   ;; gnatmake -gnatD generates files with .dg extensions. But we don't
 190   ;; need to navigate between them.
 191   ;;
 192   ;; There is no common convention for a file extension for gnatprep files.
 193
 194   (add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files, used for cross reference
 195   (add-to-list 'compilation-error-regexp-alist 'gnat)
 196   )
 197
 198 (defun ada-gnat-xref-deselect-prj ()
 199   (setq ada-file-name-from-ada-name nil)
 200   (setq ada-ada-name-from-file-name nil)
 201   (setq ada-make-package-body       nil)
 202
 203   (setq ada-syntax-propertize-hook (delq 'gnatprep-syntax-propertize ada-syntax-propertize-hook))
 204   (setq ada-syntax-propertize-hook (delq 'ada-gnat-syntax-propertize ada-syntax-propertize-hook))
 205   (setq ada-mode-hook (delq 'ada-gnat-xref-setup ada-mode-hook))
 206
 207   (setq ada-xref-other-function  nil)
 208   (setq ada-xref-parent-function nil)
 209   (setq ada-xref-all-function    nil)
 210   (setq ada-show-xref-tool-buffer nil)
 211
 212   (setq completion-ignored-extensions (delete ".ali" completion-ignored-extensions))
 213   (setq compilation-error-regexp-alist (delete 'gnat compilation-error-regexp-alist))
 214   )
 215
 216 (defun ada-gnat-xref-setup ()
 217   (when (boundp 'wisi-indent-calculate-functions)
 218     (add-to-list 'wisi-indent-calculate-functions 'gnatprep-indent))
 219   )
 220
 221 (defun ada-gnat-xref ()
 222   "Set Ada mode global vars to use 'gnat xref'"
 223   (add-to-list 'ada-prj-file-ext-extra     "gpr")
 224   (add-to-list 'ada-prj-parser-alist       '("gpr" . gnat-parse-gpr))
 225   (add-to-list 'ada-select-prj-xref-tool   '(gnat  . ada-gnat-xref-select-prj))
 226   (add-to-list 'ada-deselect-prj-xref-tool '(gnat  . ada-gnat-xref-deselect-prj))
 227
 228   ;; no parse-*-xref yet
 229
 230   (font-lock-add-keywords 'ada-mode
 231    ;; gnatprep preprocessor line
 232    (list (list "^[ \t]*\\(#.*\n\\)"  '(1 font-lock-type-face t))))
 233
 234   (add-hook 'ada-gnat-fix-error-hook 'ada-gnat-fix-error))
 235
 236 (ada-gnat-xref)
 237
 238 (provide 'ada-gnat-xref)
 239 (provide 'ada-xref-tool)
 240
 241 (unless (default-value 'ada-xref-tool)
 242   (set-default 'ada-xref-tool 'gnat))
 243
 244 ;; end of file