X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/721c270052e4e4fc671472ac871d6fe61be3681b..f10533854f4c7bb54247a11981191bf37b70cb36:/packages/ada-mode/gpr-query.el diff --git a/packages/ada-mode/gpr-query.el b/packages/ada-mode/gpr-query.el index 014d3c6fb..c22a077c3 100644 --- a/packages/ada-mode/gpr-query.el +++ b/packages/ada-mode/gpr-query.el @@ -1,4 +1,4 @@ -;;; 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++). @@ -28,6 +28,8 @@ ;; ;; 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) @@ -63,8 +65,6 @@ (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" @@ -72,10 +72,17 @@ (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 () @@ -125,7 +132,7 @@ (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) @@ -188,7 +195,7 @@ Return buffer that holds output." (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) @@ -202,16 +209,20 @@ Uses 'gpr_query'. Returns new list." 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) @@ -219,7 +230,7 @@ Uses 'gpr_query'. Returns new list." (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 ::") @@ -231,10 +242,6 @@ Uses 'gpr_query'. Returns new list." (concat gpr-query-ident-file-regexp " (\\(.*\\))") "Regexp matching :: ()") -;; 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." @@ -243,42 +250,55 @@ 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 @@ -287,18 +307,20 @@ set compilation-mode with compilation-error-regexp-alist set to COMP-ERR." ));; 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) @@ -373,8 +395,8 @@ buffer in another window." (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.") @@ -397,7 +419,7 @@ buffer in another window." (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