emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/gnat-compiler 9db5c393ee: Release version 1.0.3


From: Stephen Leake
Subject: [elpa] externals/gnat-compiler 9db5c393ee: Release version 1.0.3
Date: Fri, 22 Sep 2023 10:11:20 -0400 (EDT)

branch: externals/gnat-compiler
commit 9db5c393ee0f9694e83305ef8b0b1e37f0560111
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>

    Release version 1.0.3
    
    * NEWS: Version.
    
    * gnat-compiler.el (wisi-compiler-fix-error): Remove unwind-protect;
    not needed.
    
    * gnat-xref.el: Update comments to refer to 'gnat find'.
---
 NEWS             |   5 +
 gnat-compiler.el | 935 +++++++++++++++++++++++++++----------------------------
 gnat-xref.el     |   9 +-
 notes.text       |   5 +-
 4 files changed, 481 insertions(+), 473 deletions(-)

diff --git a/NEWS b/NEWS
index 46d88237f6..3afeb3beed 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,11 @@ Please send gnat-compiler bug reports to 
bug-gnu-emacs@gnu.org, with
 'gnat-compiler' in the subject. If possible, use M-x report-emacs-bug.
 
 
+* gnat compiler 1.0.3
+15 Sep 2023
+
+* Minor improvements, depend on wisi 4.3.0.
+
 * gnat compiler 1.0.2
 24 Jan 2023
 
diff --git a/gnat-compiler.el b/gnat-compiler.el
index 2326b68650..f29488634c 100644
--- a/gnat-compiler.el
+++ b/gnat-compiler.el
@@ -6,8 +6,8 @@
 ;;
 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
-;; Version: 1.0.2
-;; package-requires: ((emacs "25.3") (wisi "4.2.0"))
+;; Version: 1.0.3
+;; package-requires: ((emacs "25.3") (wisi "4.3.0"))
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -943,495 +943,494 @@ server executable not found; otherwise signal 
user-error."
     ;; recognize it, handle it
     (setq
      result
-     (unwind-protect
-        (cond
-         ;; It is tempting to define an alist of (MATCH . ACTION), but
-         ;; that is too hard to debug
-         ;;
-         ;; This list will get long, so let's impose some order.
-         ;;
-         ;; First expressions that start with a named regexp,
-         ;; alphabetical by variable name and following string.
-         ;;
-         ;; Then expressions that start with a string, alphabetical by string.
-         ;;
-         ;; Then style errors.
-
-         ((looking-at (concat gnat-quoted-name-regexp " is not a component of 
"))
-                  (save-excursion
-            (let ((child-name (match-string 1))
-                  (correct-spelling (gnat-misspelling)))
-              (setq correct-spelling (match-string 1))
-              (pop-to-buffer source-buffer)
-              (search-forward child-name)
-              (replace-match correct-spelling))
-            t))
-
-         ((looking-at (concat gnat-quoted-name-regexp " is not visible"))
-          (let* ((done nil)
-                 (err-msg (get-text-property (line-beginning-position) 
'compilation-message))
-                 (file-line-struct err-msg)
-                 pos choices unit-name)
-            ;; next line may contain a reference to where ident is
-            ;; defined; if present, it will have been marked by
-            ;; gnat-compilation-filter:
-            ;;
-    ;; gnatquery.adb:255:13: error: "Has_Element" is not visible
-    ;; gnatquery.adb:255:13: error: non-visible declaration at 
a-convec.ads:68, instance at gnatcoll-arg_lists.ads:157
-    ;; gnatquery.adb:255:13: error: non-visible declaration at 
a-coorse.ads:62, instance at gnatcoll-xref.ads:912
-    ;; gnatquery.adb:255:13: error: non-visible declaration at 
a-coorse.ads:62, instance at gnatcoll-xref.ads:799
-    ;; gnatquery.adb:255:13: error: non-visible declaration at 
gnatcoll-xref.ads:314
-            ;;
-            ;; or the next line may contain "multiple use clauses cause hiding"
-            ;;
-            ;; the lines after that may contain alternate matches;
-            ;; collect all, let user choose.
-            ;;
-            ;; However, a line that contains 'gnat-secondary-error may be from 
the next error message:
-            ;; parser_no_recover.adb:297:60: no selector "Tree" for type 
"Parser_State" defined at lists.ads:96
-            (forward-line 1)
-            (when (looking-at ".* multiple use clauses cause hiding")
-              (forward-line 1))
-            (while (not done)
-              (let ((limit (1- (line-end-position))))
-                ;; 1- because next compilation error is at next line beginning
-                (setq done (not
-                            (and
-                             (equal file-line-struct err-msg) ;; same error 
message?
-                             (setq pos (next-single-property-change (point) 
'gnat-secondary-error nil limit))
-                             (<= pos limit))))
-                (when (not done)
-                  (let* ((item (get-text-property pos 'gnat-secondary-error))
-                         (unit-file (nth 0 item))
-                         (choice (gnat-ada-name-from-file-name unit-file)))
-                    (unless (member choice choices) (push choice choices))
-                    (goto-char (1+ pos))
-                    (goto-char (1+ (next-single-property-change (point) 
'gnat-secondary-error nil limit)))
-                    (when (eolp)
-                      (forward-line 1)
-                      (setq file-line-struct (get-text-property (point) 
'compilation-message)))
-                    ))
+     (cond
+      ;; It is tempting to define an alist of (MATCH . ACTION), but
+      ;; that is too hard to debug
+      ;;
+      ;; This list will get long, so let's impose some order.
+      ;;
+      ;; First expressions that start with a named regexp,
+      ;; alphabetical by variable name and following string.
+      ;;
+      ;; Then expressions that start with a string, alphabetical by string.
+      ;;
+      ;; Then style errors.
+
+      ((looking-at (concat gnat-quoted-name-regexp " is not a component of "))
+       (save-excursion
+        (let ((child-name (match-string 1))
+              (correct-spelling (gnat-misspelling)))
+          (setq correct-spelling (match-string 1))
+          (pop-to-buffer source-buffer)
+          (search-forward child-name)
+          (replace-match correct-spelling))
+        t))
+
+      ((looking-at (concat gnat-quoted-name-regexp " is not visible"))
+       (let* ((done nil)
+             (err-msg (get-text-property (line-beginning-position) 
'compilation-message))
+             (file-line-struct err-msg)
+             pos choices unit-name)
+        ;; next line may contain a reference to where ident is
+        ;; defined; if present, it will have been marked by
+        ;; gnat-compilation-filter:
+        ;;
+         ;; gnatquery.adb:255:13: error: "Has_Element" is not visible
+         ;; gnatquery.adb:255:13: error: non-visible declaration at 
a-convec.ads:68, instance at gnatcoll-arg_lists.ads:157
+         ;; gnatquery.adb:255:13: error: non-visible declaration at 
a-coorse.ads:62, instance at gnatcoll-xref.ads:912
+         ;; gnatquery.adb:255:13: error: non-visible declaration at 
a-coorse.ads:62, instance at gnatcoll-xref.ads:799
+         ;; gnatquery.adb:255:13: error: non-visible declaration at 
gnatcoll-xref.ads:314
+        ;;
+        ;; or the next line may contain "multiple use clauses cause hiding"
+        ;;
+        ;; the lines after that may contain alternate matches;
+        ;; collect all, let user choose.
+        ;;
+        ;; However, a line that contains 'gnat-secondary-error may be from the 
next error message:
+        ;; parser_no_recover.adb:297:60: no selector "Tree" for type 
"Parser_State" defined at lists.ads:96
+        (forward-line 1)
+        (when (looking-at ".* multiple use clauses cause hiding")
+          (forward-line 1))
+        (while (not done)
+          (let ((limit (1- (line-end-position))))
+            ;; 1- because next compilation error is at next line beginning
+            (setq done (not
+                        (and
+                         (equal file-line-struct err-msg) ;; same error 
message?
+                         (setq pos (next-single-property-change (point) 
'gnat-secondary-error nil limit))
+                         (<= pos limit))))
+            (when (not done)
+              (let* ((item (get-text-property pos 'gnat-secondary-error))
+                     (unit-file (nth 0 item))
+                     (choice (gnat-ada-name-from-file-name unit-file)))
+                (unless (member choice choices) (push choice choices))
+                (goto-char (1+ pos))
+                (goto-char (1+ (next-single-property-change (point) 
'gnat-secondary-error nil limit)))
+                (when (eolp)
+                  (forward-line 1)
+                  (setq file-line-struct (get-text-property (point) 
'compilation-message)))
                 ))
+            ))
 
-            (setq unit-name
-                  (cond
-                   ((= 0 (length choices)) nil)
-                   ((= 1 (length choices)) (car choices))
-                   (t ;; multiple choices
-                    (completing-read "package name: " choices))))
-
-            (when unit-name
-              (pop-to-buffer source-buffer)
-              ;; We either need to add a with_clause for a package, or
-              ;; prepend the package name here (or add a use clause, but I
-              ;; don't want to do that automatically).
-              ;;
-              ;; If we need to add a with_clause, unit-name may be only
-              ;; the prefix of the real package name, but in that case
-              ;; we'll be back after the next compile; no way to get the
-              ;; full package name (without the function/type name) now.
-              ;; Note that we can't use gnat find, because the code
-              ;; doesn't compile.
+        (setq unit-name
               (cond
-               ((looking-at (concat unit-name "\\."))
-                (gnat-add-with-clause unit-name))
-               (t
-                (gnat-insert-unit-name unit-name)
-                (insert ".")))
-              t) ;; success, else nil => fail
-            ))
+               ((= 0 (length choices)) nil)
+               ((= 1 (length choices)) (car choices))
+               (t ;; multiple choices
+                (completing-read "package name: " choices))))
 
-         ((or (looking-at (concat gnat-quoted-name-regexp " is undefined"))
-              (looking-at (concat gnat-quoted-name-regexp " is not a 
predefined library unit")))
+        (when unit-name
+          (pop-to-buffer source-buffer)
           ;; We either need to add a with_clause for a package, or
-          ;; something is spelled wrong.
-          (save-excursion
-            (let ((unit-name (match-string 1))
-                  (correct-spelling (gnat-misspelling)))
-              (if correct-spelling
-                  (progn
-                    (pop-to-buffer source-buffer)
-                    (search-forward unit-name)
-                    (replace-match correct-spelling))
-
-                ;; else assume missing with
-                (pop-to-buffer source-buffer)
-                (gnat-add-with-clause unit-name))))
-          t)
-
-         ((looking-at (concat gnat-quoted-name-regexp " not declared in " 
gnat-quoted-name-regexp))
-          (save-excursion
-            (let ((child-name (match-string 1))
-                  (partial-parent-name (match-string 2))
-                  (correct-spelling (gnat-misspelling))
-                  (qualified (gnat-qualified)))
-              (cond
-               (correct-spelling
+          ;; prepend the package name here (or add a use clause, but I
+          ;; don't want to do that automatically).
+          ;;
+          ;; If we need to add a with_clause, unit-name may be only
+          ;; the prefix of the real package name, but in that case
+          ;; we'll be back after the next compile; no way to get the
+          ;; full package name (without the function/type name) now.
+          ;; Note that we can't use gnat find, because the code
+          ;; doesn't compile.
+          (cond
+           ((looking-at (concat unit-name "\\."))
+            (gnat-add-with-clause unit-name))
+           (t
+            (gnat-insert-unit-name unit-name)
+            (insert ".")))
+          t) ;; success, else nil => fail
+        ))
+
+      ((or (looking-at (concat gnat-quoted-name-regexp " is undefined"))
+          (looking-at (concat gnat-quoted-name-regexp " is not a predefined 
library unit")))
+       ;; We either need to add a with_clause for a package, or
+       ;; something is spelled wrong.
+       (save-excursion
+        (let ((unit-name (match-string 1))
+              (correct-spelling (gnat-misspelling)))
+          (if correct-spelling
+              (progn
                 (pop-to-buffer source-buffer)
-                (search-forward child-name)
+                (search-forward unit-name)
                 (replace-match correct-spelling))
 
-               (qualified
-                (pop-to-buffer source-buffer)
-                (search-forward child-name)
-                (skip-syntax-backward "w_.")
-                (insert qualified "."))
-
-               (t
-                ;; else guess that "child" is a child package, and extend the 
with_clause
-                (pop-to-buffer source-buffer)
-                (gnat-extend-with-clause partial-parent-name child-name))))
-          t))
-
-         ((looking-at (concat gnat-quoted-punctuation-regexp
-                              " should be "
-                              gnat-quoted-punctuation-regexp))
-          (let ((bad (match-string-no-properties 1))
-                (good (match-string-no-properties 2)))
+            ;; else assume missing with
             (pop-to-buffer source-buffer)
-            (looking-at bad)
-            (delete-region (match-beginning 0) (match-end 0))
-            (insert good))
-          t)
-
-;;;; strings
-         ((looking-at (concat "aspect \"" gnat-name-regexp "\" requires 
'Class"))
-          (pop-to-buffer source-buffer)
-          (forward-word 1)
-          (insert "'Class")
-          t)
-
-         ((looking-at (concat "\"end " gnat-name-regexp ";\" expected"))
-          (let ((expected-name (match-string 1)))
-            (pop-to-buffer source-buffer)
-            (if (looking-at (concat "end " gnat-name-regexp ";"))
-                (progn
-                  (goto-char (match-end 1))   ; just before ';'
-                  (delete-region (match-beginning 1) (match-end 1)))
-              ;; else we have just 'end;'
-              (forward-word 1)
-              (insert " "))
-            (insert expected-name))
-          t)
-
-         ((looking-at (concat "\"end loop " gnat-name-regexp ";\" expected"))
-          (let ((expected-name (match-string 1)))
-            (pop-to-buffer source-buffer)
-            (if (looking-at (concat "end loop " gnat-name-regexp ";"))
-                (progn
-                  (goto-char (match-end 1))   ; just before ';'
-                  (delete-region (match-beginning 1) (match-end 1)))
-              ;; else we have just 'end loop;'
-              (forward-word 2)
-              (insert " "))
-            (insert expected-name))
-          t)
-
-         ((looking-at "expected an access type")
-          (progn
-            (set-buffer source-buffer)
-            (backward-char 1)
-            (when (looking-at "\\.all")
-              (delete-char 4)
-              t)))
-
-         ((looking-at (concat "expected \\(private \\)?type " 
gnat-quoted-name-regexp))
-          (forward-line 1)
-          (move-to-column message-column)
+            (gnat-add-with-clause unit-name))))
+       t)
+
+      ((looking-at (concat gnat-quoted-name-regexp " not declared in " 
gnat-quoted-name-regexp))
+       (save-excursion
+        (let ((child-name (match-string 1))
+              (partial-parent-name (match-string 2))
+              (correct-spelling (gnat-misspelling))
+              (qualified (gnat-qualified)))
           (cond
-           ((looking-at "found procedure name")
-            (pop-to-buffer source-buffer)
-            (forward-word 1)
-            (insert "'Access")
-            t)
-           ((looking-at "found type access")
-            (pop-to-buffer source-buffer)
-            (if (looking-at "'Access")
-                (kill-word 1)
-              (forward-symbol 1)
-              (insert ".all"))
-            t)
-           ((looking-at "found type .*_Access_Type")
-            ;; assume just need '.all'
+           (correct-spelling
             (pop-to-buffer source-buffer)
-            (forward-word 1)
-            (insert ".all")
-            t)
-           ))
-
-         ((looking-at "extra \".\" ignored")
-          (set-buffer source-buffer)
-          (delete-char 1)
-          t)
+            (search-forward child-name)
+            (replace-match correct-spelling))
 
-         ((looking-at (concat "keyword " gnat-quoted-name-regexp " expected 
here"))
-          (let ((expected-keyword (match-string 1)))
+           (qualified
             (pop-to-buffer source-buffer)
-            (insert " " expected-keyword))
-          t)
+            (search-forward child-name)
+            (skip-syntax-backward "w_.")
+            (insert qualified "."))
 
-         ((looking-at "\\(?:possible \\)?missing \"with \\([[:alnum:]_.]+\\);")
-          ;; also 'possible missing "with Ada.Text_IO; use Ada.Text_IO"' - 
ignoring the 'use'
-          (let ((package-name (match-string-no-properties 1)))
+           (t
+            ;; else guess that "child" is a child package, and extend the 
with_clause
             (pop-to-buffer source-buffer)
-            ;; Could check if prefix is already with'd, extend
-            ;; it. But that's not easy. This message only occurs for
-            ;; compiler-provided Ada and GNAT packages.
-            (gnat-add-with-clause package-name))
-          t)
+            (gnat-extend-with-clause partial-parent-name child-name))))
+        t))
+
+      ((looking-at (concat gnat-quoted-punctuation-regexp
+                          " should be "
+                          gnat-quoted-punctuation-regexp))
+       (let ((bad (match-string-no-properties 1))
+            (good (match-string-no-properties 2)))
+        (pop-to-buffer source-buffer)
+        (looking-at bad)
+        (delete-region (match-beginning 0) (match-end 0))
+        (insert good))
+       t)
 
-         ;; must be after above
-         ;;
-         ;; missing "end;" for "begin" at line 234
-         ((looking-at "missing \"\\([^ ]+\\)\"")
-          (let ((stuff (match-string-no-properties 1)))
-            (set-buffer source-buffer)
-            (insert (concat stuff)));; if missing ")", don't need space; 
otherwise do?
-          t)
-
-         ((looking-at (concat "\\(?:possible \\)?misspelling of " 
gnat-quoted-name-regexp))
-          (let ((expected-name (match-string 1)))
-            (pop-to-buffer source-buffer)
-            (looking-at gnat-name-regexp)
-            (delete-region (match-beginning 1) (match-end 1))
-            (insert expected-name))
-          t)
-
-         ((looking-at "No legal interpretation for operator")
-          (forward-line 1)
-          (move-to-column message-column)
-          (looking-at (concat "use clause on " gnat-quoted-name-regexp))
-          (let ((package (match-string 1)))
-            (pop-to-buffer source-buffer)
-            (gnat-add-use package))
-          t)
-
-         ((looking-at (concat "no selector " gnat-quoted-name-regexp))
-          ;; Check next line for spelling error.
-          (save-excursion
-            (let ((unit-name (match-string 1))
-                  (correct-spelling (gnat-misspelling)))
-              (when correct-spelling
-                (pop-to-buffer source-buffer)
-                (search-forward unit-name)
-                (replace-match correct-spelling)
-                t))))
-
-         ((looking-at (concat "operator for \\(?:private \\)?type " 
gnat-quoted-name-regexp
-                              "\\(?: defined at " gnat-file-name-regexp 
"\\)?"))
-          (let ((type (match-string 1))
-                (package-file (match-string 2))
-                ;; IMPROVEME: we'd like to handle ", instance at
-                ;; <file:line:column>", but gnatcoll.xref does not
-                ;; support looking up an entity by location alone; it
-                ;; requires the name, and this error message does not
-                ;; give the name of the instance. When we implement
-                ;; adalang xref, or if the error message improves,
-                ;; try again.
-                )
-            (when package-file
-              (setq type (concat
-                          (gnat-ada-name-from-file-name package-file)
-                          "." type)))
-            (pop-to-buffer source-buffer)
-            (gnat-add-use-type type)
-          t))
-
-         ((looking-at "package \"Ada\" is hidden")
-          (pop-to-buffer source-buffer)
-          (forward-word -1)
-          (insert "Standard.")
-          t)
-
-         ((looking-at "parentheses required for unary minus")
-          (set-buffer source-buffer)
-          (insert "(")
+;;;; strings
+      ((looking-at (concat "aspect \"" gnat-name-regexp "\" requires 'Class"))
+       (pop-to-buffer source-buffer)
+       (forward-word 1)
+       (insert "'Class")
+       t)
+
+      ((looking-at (concat "\"end " gnat-name-regexp ";\" expected"))
+       (let ((expected-name (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (if (looking-at (concat "end " gnat-name-regexp ";"))
+            (progn
+              (goto-char (match-end 1))   ; just before ';'
+              (delete-region (match-beginning 1) (match-end 1)))
+          ;; else we have just 'end;'
           (forward-word 1)
-          (insert ")")
-          t)
-
-         ((looking-at "prefix of dereference must be an access type")
-          (pop-to-buffer source-buffer)
-          ;; point is after '.' in '.all'
-          (delete-region (- (point) 1) (+ (point) 3))
-          t)
-
-;;;; warnings
-         ((looking-at (concat gnat-quoted-name-regexp " is already 
use-visible"))
-          ;; just delete the 'use'; assume it's on a line by itself.
-          (pop-to-buffer source-buffer)
-          (beginning-of-line)
-          (delete-region (point) (progn (forward-line 1) (point)))
-          t)
+          (insert " "))
+        (insert expected-name))
+       t)
+
+      ((looking-at (concat "\"end loop " gnat-name-regexp ";\" expected"))
+       (let ((expected-name (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (if (looking-at (concat "end loop " gnat-name-regexp ";"))
+            (progn
+              (goto-char (match-end 1))   ; just before ';'
+              (delete-region (match-beginning 1) (match-end 1)))
+          ;; else we have just 'end loop;'
+          (forward-word 2)
+          (insert " "))
+        (insert expected-name))
+       t)
+
+      ((looking-at "expected an access type")
+       (progn
+        (set-buffer source-buffer)
+        (backward-char 1)
+        (when (looking-at "\\.all")
+          (delete-char 4)
+          t)))
+
+      ((looking-at (concat "expected \\(private \\)?type " 
gnat-quoted-name-regexp))
+       (forward-line 1)
+       (move-to-column message-column)
+       (cond
+       ((looking-at "found procedure name")
+        (pop-to-buffer source-buffer)
+        (forward-word 1)
+        (insert "'Access")
+        t)
+       ((looking-at "found type access")
+        (pop-to-buffer source-buffer)
+        (if (looking-at "'Access")
+            (kill-word 1)
+          (forward-symbol 1)
+          (insert ".all"))
+        t)
+       ((looking-at "found type .*_Access_Type")
+        ;; assume just need '.all'
+        (pop-to-buffer source-buffer)
+        (forward-word 1)
+        (insert ".all")
+        t)
+       ))
 
-         ((looking-at (concat gnat-quoted-name-regexp " is not modified, could 
be declared constant"))
-          (pop-to-buffer source-buffer)
-          (search-forward ":")
-          (forward-comment (- (point-max) (point)))
-          ;; "aliased" must be before "constant", so check for it
-          (when (looking-at "aliased")
-            (forward-word 1)
-            (forward-char 1))
-          (insert "constant ")
-          t)
-
-         ((looking-at (concat "constant " gnat-quoted-name-regexp " is not 
referenced"))
-          (let ((constant (match-string 1)))
-            (pop-to-buffer source-buffer)
-            (end-of-line)
-            (newline-and-indent)
-            (insert "pragma Unreferenced (" constant ");"))
-          t)
-
-         ((looking-at (concat "formal parameter " gnat-quoted-name-regexp " is 
not referenced"))
-          (let ((param (match-string 1))
-                cache)
-            (pop-to-buffer source-buffer)
-            ;; Point is in a subprogram parameter list;
-            ;; ada-goto-declarative-region-start goes to the package,
-            ;; not the subprogram declarative_part (this is a change
-            ;; from previous wisi versions).
-            (setq cache (wisi-goto-statement-start))
-            (while (not (eq 'IS (wisi-cache-token cache)))
-              (forward-sexp)
-              (setq cache (wisi-get-cache (point))))
-            (forward-word)
-            (newline-and-indent)
-            (insert "pragma Unreferenced (" param ");"))
-          t)
-
-         ((looking-at (concat "formal parameter " gnat-quoted-name-regexp " is 
not modified"))
-          (let ((mode-regexp "\"\\([in out]+\\)\"")
-                new-mode
-                old-mode)
-            (forward-line 1)
-            (search-forward-regexp
-             (concat "mode could be " mode-regexp " instead of " mode-regexp))
-            (setq new-mode (match-string 1))
-            (setq old-mode (match-string 2))
+      ((looking-at "extra \".\" ignored")
+       (set-buffer source-buffer)
+       (delete-char 1)
+       t)
+
+      ((looking-at (concat "keyword " gnat-quoted-name-regexp " expected 
here"))
+       (let ((expected-keyword (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (insert " " expected-keyword))
+       t)
+
+      ((looking-at "\\(?:possible \\)?missing \"with \\([[:alnum:]_.]+\\);")
+       ;; also 'possible missing "with Ada.Text_IO; use Ada.Text_IO"' - 
ignoring the 'use'
+       (let ((package-name (match-string-no-properties 1)))
+        (pop-to-buffer source-buffer)
+        ;; Could check if prefix is already with'd, extend
+        ;; it. But that's not easy. This message only occurs for
+        ;; compiler-provided Ada and GNAT packages.
+        (gnat-add-with-clause package-name))
+       t)
+
+      ;; must be after above
+      ;;
+      ;; missing "end;" for "begin" at line 234
+      ((looking-at "missing \"\\([^ ]+\\)\"")
+       (let ((stuff (match-string-no-properties 1)))
+        (set-buffer source-buffer)
+        (insert (concat stuff)));; if missing ")", don't need space; otherwise 
do?
+       t)
+
+      ((looking-at (concat "\\(?:possible \\)?misspelling of " 
gnat-quoted-name-regexp))
+       (let ((expected-name (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (looking-at gnat-name-regexp)
+        (delete-region (match-beginning 1) (match-end 1))
+        (insert expected-name))
+       t)
+
+      ((looking-at "No legal interpretation for operator")
+       (forward-line 1)
+       (move-to-column message-column)
+       (looking-at (concat "use clause on " gnat-quoted-name-regexp))
+       (let ((package (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (gnat-add-use package))
+       t)
+
+      ((looking-at (concat "no selector " gnat-quoted-name-regexp))
+       ;; Check next line for spelling error.
+       (save-excursion
+        (let ((unit-name (match-string 1))
+              (correct-spelling (gnat-misspelling)))
+          (when correct-spelling
             (pop-to-buffer source-buffer)
-            (search-forward old-mode)
-            (replace-match new-mode)
-            (gnat-align)
+            (search-forward unit-name)
+            (replace-match correct-spelling)
+            t))))
+
+      ((looking-at (concat "operator for \\(?:private \\)?type " 
gnat-quoted-name-regexp
+                          "\\(?: defined at " gnat-file-name-regexp "\\)?"))
+       (let ((type (match-string 1))
+            (package-file (match-string 2))
+            ;; IMPROVEME: we'd like to handle ", instance at
+            ;; <file:line:column>", but gnatcoll.xref does not
+            ;; support looking up an entity by location alone; it
+            ;; requires the name, and this error message does not
+            ;; give the name of the instance. When we implement
+            ;; adalang xref, or if the error message improves,
+            ;; try again.
             )
-          t)
+        (when package-file
+          (setq type (concat
+                      (gnat-ada-name-from-file-name package-file)
+                      "." type)))
+        (pop-to-buffer source-buffer)
+        (gnat-add-use-type type)
+        t))
+
+      ((looking-at "package \"Ada\" is hidden")
+       (pop-to-buffer source-buffer)
+       (forward-word -1)
+       (insert "Standard.")
+       t)
+
+      ((looking-at "parentheses required for unary minus")
+       (set-buffer source-buffer)
+       (insert "(")
+       (forward-word 1)
+       (insert ")")
+       t)
+
+      ((looking-at "prefix of dereference must be an access type")
+       (pop-to-buffer source-buffer)
+       ;; point is after '.' in '.all'
+       (delete-region (- (point) 1) (+ (point) 3))
+       t)
 
-         ((looking-at (concat "variable " gnat-quoted-name-regexp " is not 
referenced"))
-          (let ((param (match-string 1)))
-            (pop-to-buffer source-buffer)
-            (forward-sexp);; end of declaration
-            (forward-char);; skip semicolon
-            (newline-and-indent)
-            (insert "pragma Unreferenced (" param ");"))
-          t)
-
-         ((or
-           (looking-at (concat "no entities of " gnat-quoted-name-regexp " are 
referenced"))
-           (looking-at (concat "unit " gnat-quoted-name-regexp " is never 
instantiated"))
-           (looking-at (concat "renamed constant " gnat-quoted-name-regexp " 
is not referenced"))
-           (looking-at "redundant with clause"))
-          ;; just delete the declaration; assume it's on a line by itself.
-          (pop-to-buffer source-buffer)
-          (beginning-of-line)
-          (delete-region (point) (progn (forward-line 1) (point)))
-          t)
-
-         ((looking-at (concat "variable " gnat-quoted-name-regexp " is 
assigned but never read"))
-          (let ((param (match-string 1)))
-            (pop-to-buffer source-buffer)
-            (wisi-goto-statement-end) ;; leaves point before semicolon
-            (forward-char 1)
-            (newline-and-indent)
-            (insert "pragma Unreferenced (" param ");"))
-          t)
-
-         ((looking-at (concat "unit " gnat-quoted-name-regexp " is not 
referenced"))
-          ;; just delete the 'with'; assume it's on a line by itself.
-          (pop-to-buffer source-buffer)
-          (beginning-of-line)
-          (delete-region (point) (progn (forward-line 1) (point)))
-          t)
-
-         ((looking-at (concat "use clause for \\(package\\|type\\|private 
type\\) " gnat-quoted-name-regexp
-                              " \\(defined at\\|from instance at\\|has no 
effect\\)"))
-          ;; delete the 'use'; assume it's on a line by itself.
-          (pop-to-buffer source-buffer)
-          (beginning-of-line)
-          (delete-region (point) (progn (forward-line 1) (point)))
-          t)
+;;;; warnings
+      ((looking-at (concat gnat-quoted-name-regexp " is already use-visible"))
+       ;; just delete the 'use'; assume it's on a line by itself.
+       (pop-to-buffer source-buffer)
+       (beginning-of-line)
+       (delete-region (point) (progn (forward-line 1) (point)))
+       t)
+
+      ((looking-at (concat gnat-quoted-name-regexp " is not modified, could be 
declared constant"))
+       (pop-to-buffer source-buffer)
+       (search-forward ":")
+       (forward-comment (- (point-max) (point)))
+       ;; "aliased" must be before "constant", so check for it
+       (when (looking-at "aliased")
+        (forward-word 1)
+        (forward-char 1))
+       (insert "constant ")
+       t)
+
+      ((looking-at (concat "constant " gnat-quoted-name-regexp " is not 
referenced"))
+       (let ((constant (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (end-of-line)
+        (newline-and-indent)
+        (insert "pragma Unreferenced (" constant ");"))
+       t)
+
+      ((looking-at (concat "formal parameter " gnat-quoted-name-regexp " is 
not referenced"))
+       (let ((param (match-string 1))
+            cache)
+        (pop-to-buffer source-buffer)
+        ;; Point is in a subprogram parameter list;
+        ;; ada-goto-declarative-region-start goes to the package,
+        ;; not the subprogram declarative_part (this is a change
+        ;; from previous wisi versions).
+        (setq cache (wisi-goto-statement-start))
+        (while (not (eq 'IS (wisi-cache-token cache)))
+          (forward-sexp)
+          (setq cache (wisi-get-cache (point))))
+        (forward-word)
+        (newline-and-indent)
+        (insert "pragma Unreferenced (" param ");"))
+       t)
+
+      ((looking-at (concat "formal parameter " gnat-quoted-name-regexp " is 
not modified"))
+       (let ((mode-regexp "\"\\([in out]+\\)\"")
+            new-mode
+            old-mode)
+        (forward-line 1)
+        (search-forward-regexp
+         (concat "mode could be " mode-regexp " instead of " mode-regexp))
+        (setq new-mode (match-string 1))
+        (setq old-mode (match-string 2))
+        (pop-to-buffer source-buffer)
+        (search-forward old-mode)
+        (replace-match new-mode)
+        (gnat-align)
+        )
+       t)
+
+      ((looking-at (concat "variable " gnat-quoted-name-regexp " is not 
referenced"))
+       (let ((param (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (forward-sexp);; end of declaration
+        (forward-char);; skip semicolon
+        (newline-and-indent)
+        (insert "pragma Unreferenced (" param ");"))
+       t)
+
+      ((or
+       (looking-at (concat "no entities of " gnat-quoted-name-regexp " are 
referenced"))
+       (looking-at (concat "unit " gnat-quoted-name-regexp " is never 
instantiated"))
+       (looking-at (concat "renamed constant " gnat-quoted-name-regexp " is 
not referenced"))
+       (looking-at "redundant with clause"))
+       ;; just delete the declaration; assume it's on a line by itself.
+       (pop-to-buffer source-buffer)
+       (beginning-of-line)
+       (delete-region (point) (progn (forward-line 1) (point)))
+       t)
+
+      ((looking-at (concat "variable " gnat-quoted-name-regexp " is assigned 
but never read"))
+       (let ((param (match-string 1)))
+        (pop-to-buffer source-buffer)
+        (wisi-goto-statement-end) ;; leaves point before semicolon
+        (forward-char 1)
+        (newline-and-indent)
+        (insert "pragma Unreferenced (" param ");"))
+       t)
+
+      ((looking-at (concat "unit " gnat-quoted-name-regexp " is not 
referenced"))
+       ;; just delete the 'with'; assume it's on a line by itself.
+       (pop-to-buffer source-buffer)
+       (beginning-of-line)
+       (delete-region (point) (progn (forward-line 1) (point)))
+       t)
+
+      ((looking-at (concat "use clause for \\(package\\|type\\|private type\\) 
" gnat-quoted-name-regexp
+                          " \\(defined at\\|from instance at\\|has no 
effect\\)"))
+       ;; delete the 'use'; assume it's on a line by itself.
+       (pop-to-buffer source-buffer)
+       (beginning-of-line)
+       (delete-region (point) (progn (forward-line 1) (point)))
+       t)
 
 ;;;; style errors
-         ((or (looking-at "(style) \".*\" in wrong column")
-              (looking-at "(style) this token should be in column"))
-          (set-buffer source-buffer)
-          (funcall indent-line-function)
-          t)
-
-         ((looking-at "(style) bad capitalization, mixed case required")
-          (set-buffer source-buffer)
-          (forward-word)
-          (wisi-case-adjust-identifier)
-          t)
-
-         ((looking-at (concat "(style) bad casing of " 
gnat-quoted-name-regexp))
-          (let ((correct (match-string-no-properties 1))
-                end)
-            ;; gnat leaves point on first bad character, but we need to 
replace the whole word
-            (set-buffer source-buffer)
-            (skip-syntax-backward "w_")
-            (setq end (point))
-            (skip-syntax-forward "w_")
-            (delete-region (point) end)
-            (insert correct))
-          t)
-
-         ((or
-           (looking-at "(style) bad column")
-           (looking-at "(style) bad indentation")
-           (looking-at "(style) incorrect layout"))
-          (set-buffer source-buffer)
-          (funcall indent-line-function)
-          t)
-
-         ((looking-at "(style) \"exit \\(.*\\)\" required")
-          (let ((name (match-string-no-properties 1)))
-            (set-buffer source-buffer)
-            (forward-word 1)
-            (insert (concat " " name))
-          t))
-
-         ((looking-at "(style) misplaced \"then\"")
-          (set-buffer source-buffer)
-          (delete-indentation)
-          t)
-
-         ((looking-at "(style) missing \"overriding\" indicator")
-          (set-buffer source-buffer)
-          (cond
-           ((looking-at "\\(procedure\\)\\|\\(function\\)")
-            (insert "overriding ")
-           t)
-           (t
-            nil)))
-
-         ((looking-at "(style) reserved words must be all lower case")
-          (set-buffer source-buffer)
-          (downcase-word 1)
-          t)
-
-         ((looking-at "(style) space not allowed")
-          (set-buffer source-buffer)
-          ;; Error places point on space. More than one trailing space
-          ;; should be fixed by delete-trailing-whitespace in
-          ;; before-save-hook, once the file is modified.
-          (delete-char 1)
-          t)
-
-         ((looking-at "(style) space required")
-          (set-buffer source-buffer)
-          (insert " ")
-          t)
-         )));; end of setq unwind-protect cond
+      ((or (looking-at "(style) \".*\" in wrong column")
+          (looking-at "(style) this token should be in column"))
+       (set-buffer source-buffer)
+       (funcall indent-line-function)
+       t)
+
+      ((looking-at "(style) bad capitalization, mixed case required")
+       (set-buffer source-buffer)
+       (forward-word)
+       (wisi-case-adjust-identifier)
+       t)
+
+      ((looking-at (concat "(style) bad casing of " gnat-quoted-name-regexp))
+       (let ((correct (match-string-no-properties 1))
+            end)
+        ;; gnat leaves point on first bad character, but we need to replace 
the whole word
+        (set-buffer source-buffer)
+        (skip-syntax-backward "w_")
+        (setq end (point))
+        (skip-syntax-forward "w_")
+        (delete-region (point) end)
+        (insert correct))
+       t)
+
+      ((or
+       (looking-at "(style) bad column")
+       (looking-at "(style) bad indentation")
+       (looking-at "(style) incorrect layout"))
+       (set-buffer source-buffer)
+       (funcall indent-line-function)
+       t)
+
+      ((looking-at "(style) \"exit \\(.*\\)\" required")
+       (let ((name (match-string-no-properties 1)))
+        (set-buffer source-buffer)
+        (forward-word 1)
+        (insert (concat " " name))
+        t))
+
+      ((looking-at "(style) misplaced \"then\"")
+       (set-buffer source-buffer)
+       (delete-indentation)
+       t)
+
+      ((looking-at "(style) missing \"overriding\" indicator")
+       (set-buffer source-buffer)
+       (cond
+        ((looking-at "\\(procedure\\)\\|\\(function\\)")
+         (insert "overriding ")
+        t)
+        (t
+         nil)))
+
+      ((looking-at "(style) reserved words must be all lower case")
+       (set-buffer source-buffer)
+       (downcase-word 1)
+       t)
+
+      ((looking-at "(style) space not allowed")
+       (set-buffer source-buffer)
+       ;; Error places point on space. More than one trailing space
+       ;; should be fixed by delete-trailing-whitespace in
+       ;; before-save-hook, once the file is modified.
+       (delete-char 1)
+       t)
+
+      ((looking-at "(style) space required")
+       (set-buffer source-buffer)
+       (insert " ")
+       t)
+      ));; end of setq cond
     (if result
        t
       (goto-char start-pos)
diff --git a/gnat-xref.el b/gnat-xref.el
index 2a9e9a33f8..bdd1e3dd5d 100644
--- a/gnat-xref.el
+++ b/gnat-xref.el
@@ -1,11 +1,12 @@
-;;; gnat-xref.el --- cross-reference functionality provided by 'gnat xref'  
-*- lexical-binding:t -*-
+;;; gnat-xref.el --- cross-reference functionality provided by 'gnat find'  
-*- lexical-binding:t -*-
 ;;
 ;; These tools are all Ada-specific; see gpr-query for multi-language
-;; GNAT cross-reference tools.
+;; GNAT cross-reference tools. gpr-query replaces 'gnat xref'; this
+;; file is named gnat-xref for historical reasons.
 ;;
 ;; GNAT is provided by AdaCore; see https://libre.adacore.com/
 ;;
-;;; Copyright (C) 2012 - 2022  Free Software Foundation, Inc.
+;;; Copyright (C) 2012 - 2023  Free Software Foundation, Inc.
 ;;
 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
@@ -110,7 +111,7 @@
 
 (defun gnat-xref-common-cmd (project)
   "Returns the gnatfind command to run to find cross-references."
-  (format "%sgnatfind" (or (gnat-compiler-target (wisi-prj-xref project)) "")))
+  (format "%sgnat find" (or (gnat-compiler-target (wisi-prj-xref project)) 
"")))
 
 (defun gnat-xref-common-args (project identifier file line col)
   "Returns a list of arguments to pass to gnatfind.  Some
diff --git a/notes.text b/notes.text
index 107490f676..7eec9e9bed 100644
--- a/notes.text
+++ b/notes.text
@@ -1,7 +1,7 @@
  release process
 tested by ada-mode
 
-(ediff-directories "/Projects/elpa_release/gnat-compiler" 
"/Projects/elpa/packages/gnat-compiler" nil)
+(ediff-directories "/Projects/elpa_release/packages/gnat-compiler" 
"/Projects/elpa/packages/gnat-compiler" nil)
     NEWS
         copyright date
         add release date
@@ -16,4 +16,7 @@ bump versions
     NEWS
         if not done above
 
+(dvc-status ".")
+(dvc-propagate-one "/Projects/elpa/packages/wisi" 
"/Projects/elpa_release/packages/wisi")
+(dvc-sync-run "/Projects/elpa/packages/wisi")
 # end of file



reply via email to

[Prev in Thread] Current Thread [Next in Thread]