-;;; gpr-query.el --- Minor-mode for navigating sources using gpr_query -*- lexical-binding:t -*-
+;; gpr-query.el --- Minor mode for navigating sources using gpr_query -*- lexical-binding:t -*-
;;
;; gpr-query supports Ada and any gcc language that supports the
;; AdaCore -fdump-xref switch (which includes C, C++).
;;
;; M-x gpr-query
+(require 'ada-mode-compat-24.2)
+
(require 'ada-mode) ;; for ada-prj-*, some other things
(require 'gnat-core)
(require 'cl-lib)
(setf (gpr-query--session-process session)
;; gnatcoll-1.6 can't handle aggregate projects; M910-032
;; gpr_query can handle some aggregate projects, but not all
- ;; FIXME: need good error message on bad project file:
- ;; "can't handle aggregate projects?")
(start-process (concat "gpr_query " (buffer-name))
(gpr-query--session-buffer session)
"gpr_query"
(set-process-query-on-exit-flag (gpr-query--session-process session) nil)
(gpr-query-session-wait session)
- ;; check for warnings about invalid directories etc
- (goto-char (point-min))
- (when (search-forward "warning:" nil t)
- (error "gpr_query warnings"))
+ ;; Check for warnings about invalid directories etc. But some
+ ;; warnings are tolerable, so only abort if process actually
+ ;; died.
+ (if (process-live-p (gpr-query--session-process session))
+ (progn
+ (goto-char (point-min))
+ (when (search-forward "warning:" nil t)
+ (beep)
+ (message "gpr_query warnings")))
+
+ (error "gpr-query process failed to start"))
)))
(defun gpr-query--make-session ()
(not (re-search-forward gpr-query-prompt (point-max) 1))))
(setq search-start (point));; don't search same text again
(message (concat "running gpr_query ..." (make-string wait-count ?.)))
- ;; FIXME: use --display-progress
+ ;; IMPROVEME: use --display-progress
(accept-process-output process 1.0)
(setq wait-count (1+ wait-count)))
(if (process-live-p process)
(defun gpr-query-get-src-dirs (src-dirs)
"Append list of source dirs in current gpr project to SRC-DIRS.
-Uses 'gpr_query'. Returns new list."
+Uses `gpr_query'. Returns new list."
(with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
(gpr-query-session-send "source_dirs" t)
src-dirs)
(defun gpr-query-get-prj-dirs (prj-dirs)
- "Append list of source dirs in current gpr project to PRJ-DIRS.
-Uses 'gpr_query'. Returns new list."
+ "Append list of project dirs in current gpr project to PRJ-DIRS.
+Uses `gpr_query'. Returns new list."
(with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
(gpr-query-session-send "project_path" t)
(goto-char (point-min))
(while (not (looking-at gpr-query-prompt))
- (cl-pushnew (directory-file-name
- (buffer-substring-no-properties (point) (point-at-eol)))
- prj-dirs :test #'equal)
+ (cl-pushnew
+ (let ((dir (buffer-substring-no-properties (point) (point-at-eol))))
+ (if (string= dir ".")
+ (directory-file-name default-directory)
+ dir))
+ prj-dirs
+ :test #'equal)
(forward-line 1))
)
prj-dirs)
(defconst gpr-query-ident-file-regexp
;; C:\Projects\GDS\work_dscovr_release\common\1553\gds-mil_std_1553-utf.ads:252:25
;; /Projects/GDS/work_dscovr_release/common/1553/gds-mil_std_1553-utf.ads:252:25
- "\\(\\(?:.:\\\|/\\)[^:]*\\):\\([0123456789]+\\):\\([0123456789]+\\)"
+ "\\(\\(?:.:\\\\\\|/\\)[^:]*\\):\\([0123456789]+\\):\\([0123456789]+\\)"
;; 1 2 3
"Regexp matching <file>:<line>:<column>")
(concat gpr-query-ident-file-regexp " (\\(.*\\))")
"Regexp matching <file>:<line>:<column> (<type>)")
-;; debugging:
-;; in *compilation-gpr_query-refs*, run
-;; (progn (set-text-properties (point-min)(point-max) nil)(compilation-parse-errors (point-min)(point-max) gpr-query-ident-file-regexp-alist))
-
(defun gpr-query-compilation (identifier file line col cmd comp-err)
"Run gpr_query IDENTIFIER:FILE:LINE:COL CMD,
set compilation-mode with compilation-error-regexp-alist set to COMP-ERR."
;; to each result in turn via `next-error'.
(let ((cmd-1 (format "%s %s:%s:%d:%d" cmd identifier file line col))
(result-count 0)
- file line column)
+ target-file target-line target-col)
(with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
(compilation-mode)
(setq buffer-read-only nil)
(set (make-local-variable 'compilation-error-regexp-alist) (list comp-err))
(gpr-query-session-send cmd-1 t)
- ;; point is at EOB. gpr_query returns one line per result plus prompt
+ ;; point is at EOB. gpr_query returns one line per result plus prompt, warnings
(setq result-count (- (line-number-at-pos) 1))
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (with-no-warnings (font-lock-fontify-buffer)))
- ;; font-lock-fontify-buffer applies compilation-message text properties
- ;; FIXME: Won't be needed in 24.5 any more, since compilation-next-error
- ;; will apply compilation-message text properties on the fly.
- ;; IMPROVEME: for some reason, next-error works, but the font
- ;; colors are not right (no koolaid!) (fixed in 24.5?)
+ (font-lock-ensure)
+ ;; pre Emacs 25, font-lock-ensure applies compilation-message
+ ;; text properties
+ ;;
+ ;; post Emacs 25, compilation-next-error applies
+ ;; compilation-message text properties on the fly via
+ ;; compilation--ensure-parse. But that doesn't apply face text
+ ;; properties.
+ ;;
+ ;; IMPROVEME: next-error works, but the font colors are not
+ ;; right (bad regexp?)
(goto-char (point-min))
+ (cond
+ ((looking-at "^warning: ")
+ (setq result-count (1- result-count))
+ (forward-line 1))
+ ((looking-at "^Error: entity not found")
+ (error (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
+ )
(cl-case result-count
(0
(error "gpr_query returned no results"))
(1
- (when (looking-at "^Error: entity not found")
- (error (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
-
;; just go there, don't display session-buffer. We have to
- ;; fetch the compilation-message while in the session-buffer.
- (let* ((msg (compilation-next-error 0 nil (point-min)))
- ;; FIXME: '--' indicates internal-only; use compile-goto-error
- (loc (compilation--message->loc msg)))
- (setq file (caar (compilation--loc->file-struct loc))
- line (caar (cddr (compilation--loc->file-struct loc)))
- column (1- (compilation--loc->col loc)))
+ ;; fetch the compilation-message while in the
+ ;; session-buffer. and call ada-goot-source outside the
+ ;; with-current-buffer above.
+ (compilation--ensure-parse (point-max))
+ (let* ((msg (compilation-next-error 0))
+ ;; IMPROVEME: '--' indicates internal-only. But we can't
+ ;; use compile-goto-error, because that displays the
+ ;; session-buffer.
+ (loc (compilation--message->loc msg)))
+ (setq target-file (caar (compilation--loc->file-struct loc))
+ target-line (caar (cddr (compilation--loc->file-struct loc)))
+ target-col (1- (compilation--loc->col loc))
+ )
))
(t
));; case, with-currrent-buffer
- (if (> result-count 1)
- ;; more than one result; display session buffer, goto first ref
- ;;
- ;; compilation-next-error-function assumes there is not an error
- ;; at point-min; work around that by moving forward 0 errors for
- ;; the first one. Unless the first line contains "warning: ".
- (if (looking-at "^warning: ")
- (next-error)
- (next-error 0 t))
-
- ;; just one result; go there
- (ada-goto-source file line column nil))
+ (if (= result-count 1)
+ (ada-goto-source target-file target-line target-col nil)
+
+ ;; more than one result; display session buffer, goto first ref
+ ;;
+ ;; compilation-next-error-function assumes there is not an error
+ ;; at point-min; work around that by moving forward 0 errors for
+ ;; the first one. Unless the first line contains "warning: ".
+ (set-buffer next-error-last-buffer)
+ (goto-char (point-min))
+ (if (looking-at "^warning: ")
+ (next-error)
+ (next-error 0 t))
+ )
))
(defun gpr-query-dist (found-line line found-col col)
(define-key map "\C-c\C-i\C-p" 'ada-build-prompt-select-prj-file)
(define-key map "\C-c\C-i\C-q" 'gpr-query-refresh)
(define-key map "\C-c\C-i\C-r" 'gpr-query-show-references)
- ;; FIXME: (define-key map "\C-c\M-d" 'gpr-query-parents)
- ;; FIXME: overriding
+ ;; IMPROVEME: (define-key map "\C-c\M-d" 'gpr-query-parents)
+ ;; IMPROVEME: overriding
map
) "Local keymap used for gpr query minor mode.")
(define-minor-mode gpr-query
"Minor mode for navigating sources using GNAT cross reference tool.
-Enable mode if ARG is positive"
+Enable mode if ARG is positive."
:initial-value t
:lighter " gpr-query" ;; mode line