GNU bug report logs - #78489
30.1.50; Using etags, Ada and xref-find-definitions doesn't find definitions

Previous Next

Full log

Message #56 received at 78489 <at> debbugs.gnu.org (full text, mbox):

From: Troy Brown <brownts <at> troybrown.dev>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: Stefan Monnier <monnier <at> iro.umontreal.ca>, 78489 <at> debbugs.gnu.org
Subject: Re: bug#78489: 30.1.50; Using etags, Ada and xref-find-definitions
 doesn't find definitions
Date: Sat, 31 May 2025 08:54:25 -0400

On Sat, May 31, 2025 at 7:46 AM Eli Zaretskii <eliz <at> gnu.org> wrote:
>
> > From: Stefan Monnier <monnier <at> iro.umontreal.ca>
> > Cc: brownts <at> troybrown.dev,  78489 <at> debbugs.gnu.org
> > Date: Tue, 27 May 2025 12:17:12 -0400
> >
> > >> I haven't had time to look closely, but IIUC those `/p` aren't
> > >> reallypart of the completed names but only some meta-info about their
> > >> nature, so it sounds like a job for `:annotation-function` (in
> > >> `completion-at-point-function`) or `annotation-function` (in the
> > >> completion table's metadata).
> > >
> > > I'm not sure I follow: if you say that annotation-function should add
> > > those "/p" qualifiers, then that's not really possible, since they are
> > > appended by etags and are present in the TAGS file.  Ada tags always
> > > worked like that, for some reason I cannot understand, but we cannot
> > > easily change this now.
> >
> > BTW, a less-ideal solution would be to use an `:exit-function` that
> > removes the `/p`.  This is a lot more hackish because exit-functions are
> > kind of optional (different UIs run them in different circumstances or
> > not at all), plus there's the risk of removing a `/p` that was not
> > supposed to be removed.
>
> My problem is how to do this in a way that only affects "M-x
> completion-at-point", but doesn't affect completion of tags in M-. or
> other scenarios.  Can you suggest how to use the above so as to not
> affret anything except completion-at-point?

For a mode-specific solution, I'm currently using the following.  It
modifies the result of the completion table to remove the suffix, but
stores the suffix as a text property on the candidate.  Then the text
property is retrieved from within the annotation function to generate
the appropriate suffix.  In this example, I chose to use a more
descriptive suffix rather than reapplying the original one.  I'm also
using the text property to drive additional "company-kind" information
too.  This solution seems to be working well for me.

--8<---------------cut here---------------start------------->8---
(defconst ada-ts-tags--tag-regexp
  (rx (group (+ anychar))
      "/"
      (group (or "b" "f" "k" "p" "s" "t"))
      eos)
  "Regular expression matching Ada tag, including type suffix.")

(defun ada-ts-tags--adjust-completion-table (table)
  "Adjust completion TABLE to remove type suffixes from Ada tags."
  (lambda (string pred action)
    (let ((res (complete-with-action action table string pred)))
      (cond
       ;; like 'try-completion`
       ((stringp res)
        (if-let* (((string-match ada-ts-tags--tag-regexp res))
                  (mod-cand (match-string 1 res)))
            (or
             (string-equal-ignore-case mod-cand string) ; Exact match
             mod-cand) ; Longest substring, single match
          res)) ; Longest substring, multiple matches
       ;; like `all-completions`
       ((eq action t)
        (seq-map
         (lambda (cand)
           (if (string-match ada-ts-tags--tag-regexp cand)
               (let ((mod-cand (match-string 1 cand))
                     (type (match-string 2 cand)))
                 (put-text-property 0 1 'etags-ada-type type mod-cand)
                 mod-cand)
             cand))
         res))
       ;; Everything else
       (t res)))))

(defun ada-ts-tags-completion-at-point-function ()
  "Ada completion at point function for tags."
  (pcase (tags-completion-at-point-function)
    (`(,beg ,end ,table . ,plist)
     `(,beg ,end ,(ada-ts-tags--adjust-completion-table table)
            :annotation-function
            ,(lambda (cand)
               (when-let* ((type (get-text-property 0 'etags-ada-type cand)))
                 (pcase type
                   ("b" " Package Body")
                   ("f" " Function")
                   ("k" " Task")
                   ("p" " Procedure")
                   ("s" " Package Spec")
                   ("t" " Type"))))
            :company-kind
            ,(lambda (cand)
               (when-let* ((type (get-text-property 0 'etags-ada-type cand)))
                 (pcase type
                   ("b" 'module)
                   ("f" 'function)
                   ("k" 'interface)
                   ("p" 'function)
                   ("s" 'module)
                   ("t" 'interface))))
            ,@plist))))

(setq-local completion-at-point-functions
'(ada-ts-tags-completion-at-point-function))
--8<---------------cut here---------------end--------------->8---

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.