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

   1 ;;; ada-gnat-xref.el --- Ada mode cross-reference functionality provided by 'gnat xref'  -*- lexical-binding:t -*-
   2 ;;
   3 ;; These tools are all Ada-specific; see gpr-query for multi-language
   4 ;; GNAT cross-reference tools.
   5 ;;
   6 ;; GNAT is provided by AdaCore; see http://libre.adacore.com/
   7 ;;
   8 ;;; Copyright (C) 2012 - 2015  Free Software Foundation, Inc.
   9 ;;
  10 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
  11 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
  12 ;;
  13 ;; This file is part of GNU Emacs.
  14 ;;
  15 ;; GNU Emacs is free software: you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation, either version 3 of the License, or
  18 ;; (at your option) any later version.
  19 ;;
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24 ;;
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  27 ;;
  28 ;;; Usage:
  29 ;;
  30 ;; Emacs should enter Ada mode automatically when you load an Ada
  31 ;; file, based on the file extension.
  32 ;;
  33 ;; By default, ada-mode is configured to load this file, so nothing
  34 ;; special needs to done to use it.
  35
  36 (require 'ada-fix-error)
  37 (require 'compile)
  38 (require 'gnat-core)
  39
  40 ;;;;; code
  41
  42 ;;;; uses of gnat tools
  43
  44 (defconst ada-gnat-file-line-col-regexp "\\(.*\\):\\([0-9]+\\):\\([0-9]+\\)")
  45
  46 (defun ada-gnat-xref-other (identifier file line col)
  47   "For `ada-xref-other-function', using `gnat find', which is Ada-specific."
  48
  49   (when (eq ?\" (aref identifier 0))
  50     ;; gnat find wants the quotes on operators, but the column is after the first quote.
  51     (setq col (+ 1 col))
  52     )
  53
  54   (let* ((file-non-dir (file-name-nondirectory file))
  55          (arg (format "%s:%s:%d:%d" identifier file-non-dir line col))
  56          (switches (concat
  57                     "-a"
  58                     (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get 'gpr_ext)))))
  59          (result nil))
  60     (with-current-buffer (gnat-run-buffer)
  61       (gnat-run-gnat "find" (list switches arg))
  62
  63       (goto-char (point-min))
  64       (forward-line 2); skip ADA_PROJECT_PATH, 'gnat find'
  65
  66       ;; gnat find returns two items; the starting point, and the 'other' point
  67       (unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
  68         ;; no results
  69         (error "'%s' not found in cross-reference files; recompile?" identifier))
  70
  71       (while (not result)
  72         (looking-at (concat ada-gnat-file-line-col-regexp "\\(: warning:\\)?"))
  73         (if (match-string 4)
  74             ;; error in *.gpr; ignore here.
  75             (forward-line 1)
  76           ;; else process line
  77           (let ((found-file (match-string 1))
  78                 (found-line (string-to-number (match-string 2)))
  79                 (found-col  (string-to-number (match-string 3))))
  80             (if (not
  81                  (and
  82                   (equal file-non-dir found-file)
  83                   (= line found-line)
  84                   (= col found-col)))
  85                 ;; found other item
  86                 (setq result (list found-file found-line (1- found-col)))
  87               (forward-line 1))
  88             ))
  89
  90         (when (eobp)
  91           (error "gnat find did not return other item"))
  92         ))
  93     result))
  94
  95 (defun ada-gnat-xref-parents (identifier file line col)
  96   "For `ada-xref-parents-function', using `gnat find', which is Ada-specific."
  97
  98   (let* ((arg (format "%s:%s:%d:%d" identifier file line col))
  99          (switches (list
 100                     "-a"
 101                     "-d"
 102                     (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get 'gpr_ext)))
 103                     ))
 104          (result nil))
 105     (with-current-buffer (gnat-run-buffer)
 106       (gnat-run-gnat "find" (append switches (list arg)))
 107
 108       (goto-char (point-min))
 109       (forward-line 2); skip GPR_PROJECT_PATH, 'gnat find'
 110
 111       ;; gnat find returns two items; the starting point, and the 'other' point
 112       (unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
 113         ;; no results
 114         (error "'%s' not found in cross-reference files; recompile?" identifier))
 115
 116       (while (not result)
 117         (looking-at (concat ada-gnat-file-line-col-regexp "\\(: warning:\\)?"))
 118         (if (match-string 4)
 119             ;; error in *.gpr; ignore here.
 120             (forward-line 1)
 121           ;; else process line
 122           (skip-syntax-forward "^ ")
 123           (skip-syntax-forward " ")
 124           (if (looking-at (concat "derived from .* (" ada-gnat-file-line-col-regexp ")"))
 125               ;; found other item
 126               (setq result (list (match-string 1)
 127                                  (string-to-number (match-string 2))
 128                                  (1- (string-to-number (match-string 3)))))
 129             (forward-line 1))
 130           )
 131         (when (eobp)
 132           (error "gnat find did not return parent types"))
 133         ))
 134
 135     (ada-goto-source (nth 0 result)
 136                      (nth 1 result)
 137                      (nth 2 result)
 138                      nil ;; other-window
 139                      )
 140     ))
 141
 142 (defun ada-gnat-xref-all (identifier file line col)
 143   "For `ada-xref-all-function'."
 144   ;; we use `compilation-start' to run gnat, not `gnat-run', so it
 145   ;; is asynchronous, and automatically runs the compilation error
 146   ;; filter.
 147
 148   (let* ((cmd (format "gnat find -a -r %s:%s:%d:%d" identifier file line col)))
 149
 150     (with-current-buffer (gnat-run-buffer); for default-directory
 151       (let ((compilation-environment (ada-prj-get 'proc_env))
 152             (compilation-error "reference")
 153             ;; gnat find uses standard gnu format for output, so don't
 154             ;; need to set compilation-error-regexp-alist
 155             )
 156         (when (ada-prj-get 'gpr_file)
 157           (setq cmd (concat cmd " -P" (file-name-nondirectory (ada-prj-get 'gpr_file)))))
 158
 159         (compilation-start cmd
 160                            'compilation-mode
 161                            (lambda (name) (concat name "-gnatfind")))
 162     ))))
 163
 164 ;;;;; setup
 165
 166 (defun ada-gnat-xref-select-prj ()
 167   (setq ada-file-name-from-ada-name 'ada-gnat-file-name-from-ada-name)
 168   (setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
 169   (setq ada-make-package-body       'ada-gnat-make-package-body)
 170
 171   (setq ada-xref-other-function  'ada-gnat-xref-other)
 172   (setq ada-xref-parent-function 'ada-gnat-xref-parents)
 173   (setq ada-xref-all-function    'ada-gnat-xref-all)
 174   (setq ada-show-xref-tool-buffer 'ada-gnat-show-run-buffer)
 175
 176   ;; gnatmake -gnatD generates files with .dg extensions. But we don't
 177   ;; need to navigate between them.
 178
 179   (add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files, used for cross reference
 180   (add-to-list 'compilation-error-regexp-alist 'gnat)
 181   )
 182
 183 (defun ada-gnat-xref-deselect-prj ()
 184   (setq ada-file-name-from-ada-name nil)
 185   (setq ada-ada-name-from-file-name nil)
 186   (setq ada-make-package-body       nil)
 187
 188   (setq ada-xref-other-function  nil)
 189   (setq ada-xref-parent-function nil)
 190   (setq ada-xref-all-function    nil)
 191   (setq ada-show-xref-tool-buffer nil)
 192
 193   (setq completion-ignored-extensions (delete ".ali" completion-ignored-extensions))
 194   (setq compilation-error-regexp-alist (delete 'gnat compilation-error-regexp-alist))
 195   )
 196
 197 (defun ada-gnat-xref ()
 198   "Set Ada mode global vars to use 'gnat xref'"
 199   (add-to-list 'ada-prj-file-ext-extra     "gpr")
 200   (add-to-list 'ada-prj-parser-alist       '("gpr" . gnat-parse-gpr))
 201   (add-to-list 'ada-select-prj-xref-tool   '(gnat  . ada-gnat-xref-select-prj))
 202   (add-to-list 'ada-deselect-prj-xref-tool '(gnat  . ada-gnat-xref-deselect-prj))
 203
 204   ;; no parse-*-xref yet
 205
 206   (add-hook 'ada-gnat-fix-error-hook 'ada-gnat-fix-error))
 207
 208 (ada-gnat-xref)
 209
 210 (provide 'ada-gnat-xref)
 211 (provide 'ada-xref-tool)
 212
 213 (unless (default-value 'ada-xref-tool)
 214   (set-default 'ada-xref-tool 'gnat))
 215
 216 ;; end of file