code.delx.au - gnu-emacs-elpa/blob - packages/ada-mode/gpr-query.el

   1 ;;; gpr-query.el --- Minor-mode for navigating sources using gpr_query  -*- lexical-binding:t -*-
   2 ;;
   3 ;; gpr-query supports Ada and any gcc language that supports the
   4 ;; AdaCore -fdump-xref switch (which includes C, C++).
   5 ;;
   6 ;; Copyright (C) 2013 - 2015  Free Software Foundation, Inc.
   7
   8 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
   9 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
  10 ;; Version: 1.0
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Usage:
  28 ;;
  29 ;; M-x gpr-query
  30
  31 (require 'ada-mode) ;; for ada-prj-*, some other things
  32 (require 'gnat-core)
  33 (require 'cl-lib)
  34 (require 'compile)
  35
  36 ;;;;; sessions
  37
  38 ;; gpr_query reads the project files and the database at startup,
  39 ;; which is noticeably slow for a reasonably sized project. But
  40 ;; running queries after startup is fast. So we leave gpr_query
  41 ;; running, and send it new queries via stdin, getting responses via
  42 ;; stdout.
  43 ;;
  44 ;; We maintain a cache of active sessions, one per gnat project.
  45
  46 (cl-defstruct (gpr-query--session)
  47   (process nil) ;; running gpr_query
  48   (buffer nil)) ;; receives output of gpr_query
  49
  50 (defconst gpr-query-buffer-name-prefix " *gpr_query-")
  51
  52 (defun gpr-query--start-process (session)
  53   "Start the session process running gpr_query."
  54   (unless (buffer-live-p (gpr-query--session-buffer session))
  55     ;; user may have killed buffer
  56     (setf (gpr-query--session-buffer session) (gnat-run-buffer gpr-query-buffer-name-prefix)))
  57
  58   (with-current-buffer (gpr-query--session-buffer session)
  59     (let ((process-environment (ada-prj-get 'proc_env)) ;; for GPR_PROJECT_PATH
  60
  61           (project-file (file-name-nondirectory (ada-prj-get 'gpr_file))))
  62       (erase-buffer); delete any previous messages, prompt
  63       (setf (gpr-query--session-process session)
  64             ;; gnatcoll-1.6 can't handle aggregate projects; M910-032
  65             ;; gpr_query can handle some aggregate projects, but not all
  66             ;; FIXME: need good error message on bad project file:
  67             ;;          "can't handle aggregate projects?")
  68             (start-process (concat "gpr_query " (buffer-name))
  69                            (gpr-query--session-buffer session)
  70                            "gpr_query"
  71                            (concat "--project=" project-file)))
  72       (set-process-query-on-exit-flag (gpr-query--session-process session) nil)
  73       (gpr-query-session-wait session)
  74
  75       ;; check for warnings about invalid directories etc
  76       (goto-char (point-min))
  77       (when (search-forward "warning:" nil t)
  78         (error "gpr_query warnings"))
  79       )))
  80
  81 (defun gpr-query--make-session ()
  82   "Create and return a session for the current project file."
  83   (let ((session
  84          (make-gpr-query--session
  85           :buffer (gnat-run-buffer gpr-query-buffer-name-prefix))))
  86     (gpr-query--start-process session)
  87     session))
  88
  89 (defvar gpr-query--sessions '()
  90   "Assoc list of sessions, indexed by absolute GNAT project file name.")
  91
  92 (defun gpr-query-cached-session ()
  93   "Return a session for the current project file, creating it if necessary."
  94   (let* ((session (cdr (assoc ada-prj-current-file gpr-query--sessions))))
  95     (if session
  96         (progn
  97           (unless (process-live-p (gpr-query--session-process session))
  98             (gpr-query--start-process session))
  99           session)
 100       ;; else
 101       (prog1
 102           (setq session (gpr-query--make-session))
 103         (setq gpr-query--sessions
 104               (cl-acons ada-prj-current-file session gpr-query--sessions))))
 105     ))
 106
 107 (defconst gpr-query-prompt "^>>> $"
 108   ;; gpr_query output ends with this
 109   "Regexp matching gpr_query prompt; indicates previous command is complete.")
 110
 111 (defun gpr-query-session-wait (session)
 112   "Wait for the current command to complete."
 113   (unless (process-live-p (gpr-query--session-process session))
 114     (gpr-query-show-buffer session)
 115     (error "gpr-query process died"))
 116
 117   (with-current-buffer (gpr-query--session-buffer session)
 118     (let ((process (gpr-query--session-process session))
 119           (search-start (point-min))
 120           (wait-count 0))
 121       (while (and (process-live-p process)
 122                   (progn
 123                     ;; process output is inserted before point, so move back over it to search it
 124                     (goto-char search-start)
 125                     (not (re-search-forward gpr-query-prompt (point-max) 1))))
 126         (setq search-start (point));; don't search same text again
 127         (message (concat "running gpr_query ..." (make-string wait-count ?.)))
 128         ;; FIXME: use --display-progress
 129         (accept-process-output process 1.0)
 130         (setq wait-count (1+ wait-count)))
 131       (if (process-live-p process)
 132           (message (concat "running gpr_query ... done"))
 133         (gpr-query-show-buffer session)
 134         (error "gpr_query process died"))
 135       )))
 136
 137 (defun gpr-require-prj ()
 138   "Throw error if no project file defined."
 139   (unless (or (ada-prj-get 'gpr_file)
 140               (ada-prj-get 'gpr_query_file))
 141     (error "no gpr project file defined.")))
 142
 143 (defun gpr-query-session-send (cmd wait)
 144   "Send CMD to gpr_query session for current project.
 145 If WAIT is non-nil, wait for command to complete.
 146 Return buffer that holds output."
 147   (gpr-require-prj)
 148   (let ((session (gpr-query-cached-session)))
 149     ;; always wait for previous command to complete; also checks for
 150     ;; dead process.
 151     (gpr-query-session-wait session)
 152     (with-current-buffer (gpr-query--session-buffer session)
 153       (erase-buffer)
 154       (process-send-string (gpr-query--session-process session)
 155                            (concat cmd "\n"))
 156       (when wait
 157         (gpr-query-session-wait session))
 158       (current-buffer)
 159       )))
 160
 161 (defun gpr-query-kill-session (session)
 162   (let ((process (gpr-query--session-process session)))
 163     (when (process-live-p process)
 164       (process-send-string (gpr-query--session-process session) "exit\n")
 165       (while (process-live-p process)
 166         (accept-process-output process 1.0)))
 167     ))
 168
 169 (defun gpr-query-kill-all-sessions ()
 170   (interactive)
 171   (let ((count 0))
 172     (mapc (lambda (assoc)
 173             (let ((session (cdr assoc)))
 174               (when (process-live-p (gpr-query--session-process session))
 175                 (setq count (1+ count))
 176                 (process-send-string (gpr-query--session-process session) "exit\n")
 177                 )))
 178             gpr-query--sessions)
 179     (message "Killed %d sessions" count)
 180     ))
 181
 182 (defun gpr-query-show-buffer (&optional session)
 183   "For `ada-show-xref-tool-buffer'; show gpr-query buffer for current project."
 184   (interactive)
 185   (pop-to-buffer (gpr-query--session-buffer (or session (gpr-query-cached-session)))))
 186
 187 ;;;;; utils
 188
 189 (defun gpr-query-get-src-dirs (src-dirs)
 190   "Append list of source dirs in current gpr project to SRC-DIRS.
 191 Uses 'gpr_query'. Returns new list."
 192
 193   (with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
 194     (gpr-query-session-send "source_dirs" t)
 195     (goto-char (point-min))
 196     (while (not (looking-at gpr-query-prompt))
 197       (cl-pushnew (directory-file-name
 198                     (buffer-substring-no-properties (point) (point-at-eol)))
 199                   src-dirs :test #'equal)
 200       (forward-line 1))
 201     )
 202   src-dirs)
 203
 204 (defun gpr-query-get-prj-dirs (prj-dirs)
 205   "Append list of source dirs in current gpr project to PRJ-DIRS.
 206 Uses 'gpr_query'. Returns new list."
 207
 208   (with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
 209     (gpr-query-session-send "project_path" t)
 210     (goto-char (point-min))
 211     (while (not (looking-at gpr-query-prompt))
 212       (cl-pushnew (directory-file-name
 213                     (buffer-substring-no-properties (point) (point-at-eol)))
 214                   prj-dirs :test #'equal)
 215       (forward-line 1))
 216     )
 217   prj-dirs)
 218
 219 (defconst gpr-query-ident-file-regexp
 220   ;; C:\Projects\GDS\work_dscovr_release\common\1553\gds-mil_std_1553-utf.ads:252:25
 221   ;; /Projects/GDS/work_dscovr_release/common/1553/gds-mil_std_1553-utf.ads:252:25
 222   "\\(\\(?:.:\\\|/\\)[^:]*\\):\\([0123456789]+\\):\\([0123456789]+\\)"
 223   ;; 1                          2                   3
 224   "Regexp matching <file>:<line>:<column>")
 225
 226 (defconst gpr-query-ident-file-regexp-alist
 227   (list (concat "^" gpr-query-ident-file-regexp) 1 2 3)
 228   "For compilation-error-regexp-alist, matching gpr_query output")
 229
 230 (defconst gpr-query-ident-file-type-regexp
 231   (concat gpr-query-ident-file-regexp " (\\(.*\\))")
 232   "Regexp matching <file>:<line>:<column> (<type>)")
 233
 234 ;; debugging:
 235 ;; in *compilation-gpr_query-refs*, run
 236 ;;  (progn (set-text-properties (point-min)(point-max) nil)(compilation-parse-errors (point-min)(point-max) gpr-query-ident-file-regexp-alist))
 237
 238 (defun gpr-query-compilation (identifier file line col cmd comp-err)
 239   "Run gpr_query IDENTIFIER:FILE:LINE:COL CMD,
 240 set compilation-mode with compilation-error-regexp-alist set to COMP-ERR."
 241   ;; Useful when gpr_query will return a list of references; we use
 242   ;; `compilation-start' to run gpr_query, so the user can navigate
 243   ;; to each result in turn via `next-error'.
 244   (let ((cmd-1 (format "%s %s:%s:%d:%d" cmd identifier file line col))
 245         (result-count 0)
 246         file line column)
 247     (with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
 248       (compilation-mode)
 249       (setq buffer-read-only nil)
 250       (set (make-local-variable 'compilation-error-regexp-alist) (list comp-err))
 251       (gpr-query-session-send cmd-1 t)
 252
 253       ;; point is at EOB. gpr_query returns one line per result plus prompt
 254       (setq result-count (- (line-number-at-pos) 1))
 255
 256       (if (fboundp 'font-lock-ensure)
 257           (font-lock-ensure)
 258         (with-no-warnings (font-lock-fontify-buffer)))
 259       ;; font-lock-fontify-buffer applies compilation-message text properties
 260       ;; FIXME: Won't be needed in 24.5 any more, since compilation-next-error
 261       ;; will apply compilation-message text properties on the fly.
 262       ;; IMPROVEME: for some reason, next-error works, but the font
 263       ;; colors are not right (no koolaid!) (fixed in 24.5?)
 264
 265       (goto-char (point-min))
 266
 267       (cl-case result-count
 268         (0
 269          (error "gpr_query returned no results"))
 270         (1
 271          (when (looking-at "^Error: entity not found")
 272            (error (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
 273
 274          ;; just go there, don't display session-buffer. We have to
 275          ;; fetch the compilation-message while in the session-buffer.
 276          (let* ((msg (compilation-next-error 0 nil (point-min)))
 277                 ;; FIXME: '--' indicates internal-only; use compile-goto-error
 278                 (loc (compilation--message->loc msg)))
 279            (setq file (caar (compilation--loc->file-struct loc))
 280                  line (caar (cddr (compilation--loc->file-struct loc)))
 281                  column (1- (compilation--loc->col loc)))
 282            ))
 283
 284         (t
 285          ;; for next-error, below
 286          (setq next-error-last-buffer (current-buffer)))
 287
 288         ));; case, with-currrent-buffer
 289
 290     (if (> result-count 1)
 291         ;; more than one result; display session buffer, goto first ref
 292         ;;
 293         ;; compilation-next-error-function assumes there is not an error
 294         ;; at point-min; work around that by moving forward 0 errors for
 295         ;; the first one. Unless the first line contains "warning: ".
 296         (if (looking-at "^warning: ")
 297             (next-error)
 298           (next-error 0 t))
 299
 300       ;; just one result; go there
 301       (ada-goto-source file line column nil))
 302     ))
 303
 304 (defun gpr-query-dist (found-line line found-col col)
 305   "Return distance between FOUND-LINE FOUND-COL and LINE COL."
 306   (+ (abs (- found-col col))
 307      (* (abs (- found-line line)) 250)))
 308
 309 ;;;;; user interface functions
 310
 311 (defun gpr-query-show-references ()
 312   "Show all references of identifier at point."
 313   (interactive)
 314   (gpr-query-all
 315    (thing-at-point 'symbol)
 316    (file-name-nondirectory (buffer-file-name))
 317    (line-number-at-pos)
 318    (1+ (current-column)))
 319   )
 320
 321 (defun gpr-query-overridden (other-window)
 322   "Move to the overridden declaration of the identifier around point.
 323 If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
 324 buffer in another window."
 325   (interactive "P")
 326
 327   (let ((target
 328          (gpr-query-overridden-1
 329           (thing-at-point 'symbol)
 330           (buffer-file-name)
 331           (line-number-at-pos)
 332           (save-excursion
 333             (goto-char (car (bounds-of-thing-at-point 'symbol)))
 334             (1+ (current-column)))
 335           )))
 336
 337     (ada-goto-source (nth 0 target)
 338                      (nth 1 target)
 339                      (nth 2 target)
 340                      other-window)
 341     ))
 342
 343 (defun gpr-query-goto-declaration (other-window)
 344   "Move to the declaration or body of the identifier around point.
 345 If at the declaration, go to the body, and vice versa. If at a
 346 reference, goto the declaration.
 347
 348 If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
 349 buffer in another window."
 350   (interactive "P")
 351
 352   (let ((target
 353          (gpr-query-other
 354           (thing-at-point 'symbol)
 355           (buffer-file-name)
 356           (line-number-at-pos)
 357           (save-excursion
 358             (goto-char (car (bounds-of-thing-at-point 'symbol)))
 359             (1+ (current-column)))
 360           )))
 361
 362     (ada-goto-source (nth 0 target)
 363                      (nth 1 target)
 364                      (nth 2 target)
 365                      other-window)
 366     ))
 367
 368 (defvar gpr-query-map
 369   (let ((map (make-sparse-keymap)))
 370     ;; C-c C-i prefix for gpr-query minor mode
 371
 372     (define-key map "\C-c\C-i\C-d" 'gpr-query-goto-declaration)
 373     (define-key map "\C-c\C-i\C-p" 'ada-build-prompt-select-prj-file)
 374     (define-key map "\C-c\C-i\C-q" 'gpr-query-refresh)
 375     (define-key map "\C-c\C-i\C-r" 'gpr-query-show-references)
 376     ;; FIXME: (define-key map "\C-c\M-d" 'gpr-query-parents)
 377     ;; FIXME: overriding
 378     map
 379   )  "Local keymap used for gpr query minor mode.")
 380
 381 (defvar gpr-query-menu (make-sparse-keymap "gpr-query"))
 382 (easy-menu-define gpr-query-menu gpr-query-map "Menu keymap for gpr-query minor mode"
 383   '("gpr-query"
 384     ["Find and select project ..."   ada-build-prompt-select-prj-file t]
 385     ["Select project ..."            ada-prj-select                   t]
 386     ["Show current project"          ada-prj-show                     t]
 387     ["Show gpr-query buffer"         gpr-query-show-buffer            t]
 388     ["Next compilation error"        next-error                       t]
 389     ["Show secondary error"          ada-show-secondary-error         t]
 390     ["Goto declaration/body"         gpr-query-goto-declaration       t]
 391     ["Show parent declarations"      ada-show-declaration-parents     t]
 392     ["Show references"               gpr-query-show-references        t]
 393     ;; ["Show overriding"               gpr-query-show-overriding        t]
 394     ;; ["Show overridden"               gpr-query-show-overridden        t]
 395     ["Refresh cross reference cache" gpr-query-refresh        t]
 396     ))
 397
 398 (define-minor-mode gpr-query
 399   "Minor mode for navigating sources using GNAT cross reference tool.
 400 Enable mode if ARG is positive"
 401   :initial-value t
 402   :lighter       " gpr-query"   ;; mode line
 403
 404   ;; just enable the menu and keymap
 405   )
 406
 407 ;;;;; support for Ada mode
 408
 409 (defun gpr-query-refresh ()
 410   "For `ada-xref-refresh-function', using gpr_query."
 411   (interactive)
 412   ;; need to kill session to get changed env vars etc
 413   (let ((session (gpr-query-cached-session)))
 414     (gpr-query-kill-session session)
 415     (gpr-query--start-process session)))
 416
 417 (defun gpr-query-other (identifier file line col)
 418   "For `ada-xref-other-function', using gpr_query."
 419   (when (eq ?\" (aref identifier 0))
 420     ;; gpr_query wants the quotes stripped
 421     (setq col (+ 1 col))
 422     (setq identifier (substring identifier 1 (1- (length identifier))))
 423     )
 424
 425   (when (eq system-type 'windows-nt)
 426     ;; Since Windows file system is case insensitive, GNAT and Emacs
 427     ;; can disagree on the case, so convert all to lowercase.
 428     (setq file (downcase file)))
 429
 430   (let ((cmd (format "refs %s:%s:%d:%d" identifier (file-name-nondirectory file) line col))
 431         (decl-loc nil)
 432         (body-loc nil)
 433         (search-type nil)
 434         (min-distance (1- (expt 2 29)))
 435         (result nil))
 436
 437     (with-current-buffer (gpr-query-session-send cmd t)
 438       ;; 'gpr_query refs' returns a list containing the declaration,
 439       ;; the body, and all the references, in no particular order.
 440       ;;
 441       ;; We search the list, looking for the input location,
 442       ;; declaration and body, then return the declaration or body as
 443       ;; appropriate.
 444       ;;
 445       ;; the format of each line is file:line:column (type)
 446       ;;                            1    2    3       4
 447       ;;
 448       ;; 'type' can be:
 449       ;;   body
 450       ;;   declaration
 451       ;;   full declaration  (for a private type)
 452       ;;   implicit reference
 453       ;;   reference
 454       ;;   static call
 455       ;;
 456       ;; Module_Type:/home/Projects/GDS/work_stephe_2/common/1553/gds-hardware-bus_1553-wrapper.ads:171:9 (full declaration)
 457       ;;
 458       ;; itc_assert:/home/Projects/GDS/work_stephe_2/common/itc/opsim/itc_dscovr_gdsi/Gds1553/src/Gds1553.cpp:830:9 (reference)
 459
 460       (message "parsing result ...")
 461
 462       (goto-char (point-min))
 463
 464       (while (not (eobp))
 465         (cond
 466          ((looking-at gpr-query-ident-file-type-regexp)
 467           ;; process line
 468           (let* ((found-file (match-string 1))
 469                  (found-line (string-to-number (match-string 2)))
 470                  (found-col  (string-to-number (match-string 3)))
 471                  (found-type (match-string 4))
 472                  (dist       (gpr-query-dist found-line line found-col col))
 473                  )
 474
 475             (when (eq system-type 'windows-nt)
 476               ;; 'expand-file-name' converts Windows directory
 477               ;; separators to normal Emacs.  Since Windows file
 478               ;; system is case insensitive, GNAT and Emacs can
 479               ;; disagree on the case, so convert all to lowercase.
 480               (setq found-file (downcase (expand-file-name found-file))))
 481
 482             (when (string-equal found-type "declaration")
 483               (setq decl-loc (list found-file found-line (1- found-col))))
 484
 485             (when (or
 486                    (string-equal found-type "body")
 487                    (string-equal found-type "full declaration"))
 488               (setq body-loc (list found-file found-line (1- found-col))))
 489
 490             (when
 491                 ;; The source may have changed since the xref database
 492                 ;; was computed, so allow for fuzzy matches.
 493                 (and (equal found-file file)
 494                      (< dist min-distance))
 495               (setq min-distance dist)
 496               (setq search-type found-type))
 497             ))
 498
 499          (t ;; ignore line
 500           ;;
 501           ;; This skips GPR_PROJECT_PATH and echoed command at start of buffer.
 502           ;;
 503           ;; It also skips warning lines. For example,
 504           ;; gnatcoll-1.6w-20130902 can't handle the Auto_Text_IO
 505           ;; language, because it doesn't use the gprconfig
 506           ;; configuration project. That gives lines like:
 507           ;;
 508           ;; common_text_io.gpr:15:07: language unknown for "gds-hardware-bus_1553-time_tone.ads"
 509           ;;
 510           ;; There are probably other warnings that might be reported as well.
 511           )
 512          )
 513         (forward-line 1)
 514         )
 515
 516       (cond
 517        ((null search-type)
 518         nil)
 519
 520        ((and
 521          (string-equal search-type "declaration")
 522          body-loc)
 523         (setq result body-loc))
 524
 525        (decl-loc
 526         (setq result decl-loc))
 527        )
 528
 529       (when (null result)
 530         (error "gpr_query did not return other item; refresh?"))
 531
 532       (message "parsing result ... done")
 533       result)))
 534
 535 (defun gpr-query-all (identifier file line col)
 536   "For `ada-xref-all-function', using gpr_query."
 537   (gpr-query-compilation identifier file line col "refs" 'gpr-query-ident-file))
 538
 539 (defun gpr-query-parents (identifier file line col)
 540   "For `ada-xref-parent-function', using gpr_query."
 541   (gpr-query-compilation identifier file line col "parent_types" 'gpr-query-ident-file))
 542
 543 (defun gpr-query-overriding (identifier file line col)
 544   "For `ada-xref-overriding-function', using gpr_query."
 545   (gpr-query-compilation identifier file line col "overriding" 'gpr-query-ident-file))
 546
 547 (defun gpr-query-overridden-1 (identifier file line col)
 548   "For `ada-xref-overridden-function', using gpr_query."
 549   (when (eq ?\" (aref identifier 0))
 550     ;; gpr_query wants the quotes stripped
 551     (setq col (+ 1 col))
 552     (setq identifier (substring identifier 1 (1- (length identifier))))
 553     )
 554
 555   (let ((cmd (format "overridden %s:%s:%d:%d" identifier (file-name-nondirectory file) line col))
 556         result)
 557     (with-current-buffer (gpr-query-session-send cmd t)
 558
 559       (goto-char (point-min))
 560       (when (looking-at gpr-query-ident-file-regexp)
 561         (setq result
 562               (list
 563                (match-string 1)
 564                (string-to-number (match-string 2))
 565                (string-to-number (match-string 3)))))
 566
 567       (when (null result)
 568         (error "gpr_query did not return a result; refresh?"))
 569
 570       (message "parsing result ... done")
 571       result)))
 572
 573 (defun ada-gpr-query-select-prj ()
 574   (setq ada-file-name-from-ada-name 'ada-gnat-file-name-from-ada-name)
 575   (setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
 576   (setq ada-make-package-body       'ada-gnat-make-package-body)
 577
 578   (setq ada-xref-refresh-function    'gpr-query-refresh)
 579   (setq ada-xref-all-function        'gpr-query-all)
 580   (setq ada-xref-other-function      'gpr-query-other)
 581   (setq ada-xref-parent-function     'gpr-query-parents)
 582   (setq ada-xref-all-function        'gpr-query-all)
 583   (setq ada-xref-overriding-function 'gpr-query-overriding)
 584   (setq ada-xref-overridden-function 'gpr-query-overridden-1)
 585   (setq ada-show-xref-tool-buffer    'gpr-query-show-buffer)
 586
 587   (add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files, used for cross reference
 588   )
 589
 590 (defun ada-gpr-query-deselect-prj ()
 591   (setq ada-file-name-from-ada-name nil)
 592   (setq ada-ada-name-from-file-name nil)
 593   (setq ada-make-package-body       nil)
 594
 595   (setq ada-xref-other-function      nil)
 596   (setq ada-xref-parent-function     nil)
 597   (setq ada-xref-all-function        nil)
 598   (setq ada-xref-overriding-function nil)
 599   (setq ada-xref-overridden-function nil)
 600   (setq ada-show-xref-tool-buffer    nil)
 601
 602   (setq completion-ignored-extensions (delete ".ali" completion-ignored-extensions))
 603   )
 604
 605 (defun ada-gpr-query ()
 606   "Set Ada mode global vars to use gpr_query."
 607   (add-to-list 'ada-prj-parser-alist       '("gpr" . gnat-parse-gpr))
 608   (add-to-list 'ada-select-prj-xref-tool   '(gpr_query . ada-gpr-query-select-prj))
 609   (add-to-list 'ada-deselect-prj-xref-tool '(gpr_query . ada-gpr-query-deselect-prj))
 610
 611   ;; no parse-*-xref
 612   )
 613
 614 (provide 'gpr-query)
 615 (provide 'ada-xref-tool)
 616
 617 (add-to-list 'compilation-error-regexp-alist-alist
 618              (cons 'gpr-query-ident-file       gpr-query-ident-file-regexp-alist))
 619
 620 (unless (and (boundp 'ada-xref-tool)
 621              (default-value 'ada-xref-tool))
 622   (setq ada-xref-tool 'gpr_query))
 623
 624 (ada-gpr-query)
 625
 626 ;;; end of file