;;; gpr-query.el --- minor-mode for navigating sources using the
-;;; custom gpr_query tool, based on AdaCore cross reference tool
-;;; gnatinspect.
+;;; custom gpr_query tool.
;;;
;;; 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) ;; for ada-prj-*, some other things
+(require 'gnat-core)
(require 'cl-lib)
(require 'compile)
(cl-defstruct (gpr-query--session)
(process nil) ;; running gpr_query
- (buffer nil) ;; receives output of gpr_query
- (sent-kill-p nil)
- (closed-p nil))
+ (buffer nil)) ;; receives output of gpr_query
(defconst gpr-query-buffer-name-prefix " *gpr_query-")
(defun gpr-query-session-wait (session)
"Wait for the current command to complete."
(unless (process-live-p (gpr-query--session-process session))
+ (gpr-query-show-buffer session)
(error "gpr-query process died"))
(with-current-buffer (gpr-query--session-buffer session)
(setq wait-count (1+ wait-count)))
(if (process-live-p process)
(message (concat "running gpr_query ... done"))
+ (gpr-query-show-buffer session)
(error "gpr_query process died"))
)))
Return buffer that holds output."
(gpr-require-prj)
(let ((session (gpr-query-cached-session)))
+ ;; always wait for previous command to complete; also checks for
+ ;; dead process.
+ (gpr-query-session-wait session)
(with-current-buffer (gpr-query--session-buffer session)
- ;; FIXME: Check prev command complete (might not have waited); look for prompt at EOB
(erase-buffer)
(process-send-string (gpr-query--session-process session)
(concat cmd "\n"))
(current-buffer)
)))
+(defun gpr-query-kill-session (session)
+ (let ((process (gpr-query--session-process session)))
+ (when (process-live-p process)
+ (process-send-string (gpr-query--session-process session) "exit\n")
+ (while (process-live-p process)
+ (accept-process-output process 1.0)))
+ ))
+
(defun gpr-query-kill-all-sessions ()
(interactive)
(let ((count 0))
(message "Killed %d sessions" count)
))
-(defun gpr-query-show-buffer ()
- "Show gpr-query buffer for current project."
+(defun gpr-query-show-buffer (&optional session)
+ "For `ada-show-xref-tool-buffer'; show gpr-query buffer for current project."
(interactive)
- (pop-to-buffer (gpr-query--session-buffer (gpr-query-cached-session))))
+ (pop-to-buffer (gpr-query--session-buffer (or session (gpr-query-cached-session)))))
;;;;; utils
(gpr-query-session-send "source_dirs" t)
(goto-char (point-min))
(while (not (looking-at gpr-query-prompt))
- (add-to-list 'src-dirs
- (directory-file-name
- (buffer-substring-no-properties (point) (point-at-eol))))
+ (cl-pushnew (directory-file-name
+ (buffer-substring-no-properties (point) (point-at-eol)))
+ src-dirs :test #'equal)
(forward-line 1))
)
src-dirs)
(gpr-query-session-send "project_path" t)
(goto-char (point-min))
(while (not (looking-at gpr-query-prompt))
- (add-to-list 'prj-dirs
- (directory-file-name
- (buffer-substring-no-properties (point) (point-at-eol))))
+ (cl-pushnew (directory-file-name
+ (buffer-substring-no-properties (point) (point-at-eol)))
+ prj-dirs :test #'equal)
(forward-line 1))
)
prj-dirs)
(gpr-query-session-send cmd-1 t)
;; point is at EOB. gpr_query returns one line per result plus prompt
(setq result-count (- (line-number-at-pos) 1))
- (font-lock-fontify-buffer)
+ ;; Won't be needed in 24.5 any more.
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (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!)
(goto-char (point-min))
;; 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)))
;; FIXME: (define-key map "\C-c\M-d" 'gpr-query-parents)
;; FIXME: overriding
map
- ) "Local keymap used for GNAT inspect minor mode.")
+ ) "Local keymap used for gpr query minor mode.")
(defvar gpr-query-menu (make-sparse-keymap "gpr-query"))
(easy-menu-define gpr-query-menu gpr-query-map "Menu keymap for gpr-query minor mode"
(defun gpr-query-refresh ()
"For `ada-xref-refresh-function', using gpr_query."
(interactive)
- (with-current-buffer (gpr-query-session-send "refresh" t)))
+ ;; need to kill session to get changed env vars etc
+ (let ((session (gpr-query-cached-session)))
+ (gpr-query-kill-session session)
+ (gpr-query--start-process session)))
(defun gpr-query-other (identifier file line col)
"For `ada-xref-other-function', using gpr_query."
(setq identifier (substring identifier 1 (1- (length identifier))))
)
+ (when (eq system-type 'windows-nt)
+ ;; Since Windows file system is case insensitive, GNAT and Emacs
+ ;; can disagree on the case, so convert all to lowercase.
+ (setq file (downcase file)))
+
(let ((cmd (format "refs %s:%s:%d:%d" identifier (file-name-nondirectory file) line col))
(decl-loc nil)
(body-loc nil)
(dist (gpr-query-dist found-line line found-col col))
)
+ (when (eq system-type 'windows-nt)
+ ;; 'expand-file-name' converts Windows directory
+ ;; separators to normal Emacs. Since Windows file
+ ;; system is case insensitive, GNAT and Emacs can
+ ;; disagree on the case, so convert all to lowercase.
+ (setq found-file (downcase (expand-file-name found-file))))
+
(when (string-equal found-type "declaration")
(setq decl-loc (list found-file found-line (1- found-col))))
(font-lock-add-keywords 'ada-mode
;; gnatprep preprocessor line
- (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-type-face t))))
+ (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-preprocessor-face t))))
)
(provide 'gpr-query)