Subject: Re: bug#78489: 30.1.50; Using etags, Ada and xref-find-definitions doesn't find definitions

From: Stefan Monnier <[email-masked]>
Date: Sat, 31 May 2025 14:26:57 -0400

> 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?

To the extend that `M-.` could decide to use `completion-at-point`, I'm
not sure this is possible in general, but maybe a patch like the one below
can work well enough in practice?

        Stefan
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index f14d91504af..2dd76341c64 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -59,7 +59,7 @@ tags-case-fold-search
 		 (const :tag "Case-insensitive" t)
 		 (other :tag "Use default" default))
   :version "21.1"
-  :safe 'symbolp)
+  :safe #'symbolp)
 
 ;;;###autoload
 ;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
@@ -808,6 +808,9 @@ tags-completion-table
           (quit (message "Tags completion table construction aborted.")
                 (setq tags-completion-table nil))))))
 
+(defvar tag--suffix-regexp "/[fpsbtk]"
+  "Suffix part of some tags.  Used in Ada tags to classify them by \"type\".")
+
 ;;;###autoload
 (defun tags-lazy-completion-table ()
   (let ((buf (current-buffer)))
@@ -842,7 +845,24 @@ tags-completion-at-point-function
           (when (search-backward pattern nil t)
             (setq beg (point))
             (forward-char (length pattern))
-            (list beg (point) (tags-lazy-completion-table) :exclusive 'no)))))))
+            (list beg (point) (tags-lazy-completion-table)
+                  :exclusive 'no
+                  :exit-function
+                  (lambda (str status)
+                    ;; Strip away any tag suffix, since they're not really
+                    ;; part of their names.
+                    ;; FIXME: Maybe it would be better to strip them from
+                    ;; the completion table entries (and re-add them for
+                    ;; display via an `annotation-function').
+                    (when (and (eq status 'finished)
+                               (string-match (concat tag--suffix-regexp "\\'")
+                                             str))
+                      (let ((suffix (match-string 0 str)))
+                        (when (equal suffix
+                                     (buffer-substring
+                                      (- (point) (length suffix)) (point)))
+                          (delete-region (- (point) (length suffix))
+                                         (point)))))))))))))
 
 (defun find-tag-tag (string)
   "Read a tag name, with defaulting and completion."
@@ -1635,6 +1655,7 @@ tag-file-name-match-p
        (save-excursion (backward-char (1+ (length tag)))
 		       (looking-at "/"))))
 
+;; FIXME: What does the comment below refer to?
 ;; this / to detect we are after a directory separator is ok for unix,
 ;; is there a variable that contains the regexp for directory separator
 ;; on whatever operating system ?
@@ -1651,8 +1672,7 @@ tag-exact-match-p
       ;; We are not on the explicit tag name, but perhaps it follows.
       (looking-at (concat "[^\177\n]*\177"
                           (regexp-quote tag)
-                          ;; The optional "/x" part is for Ada tags.
-                          "\\(/[fpsbtk]\\)?\001"))))
+                          "\\(" tag--suffix-regexp "\\)?\001"))))
 
 ;; t if point is at a tag line that has an implicit name.
 ;; point should be just after a string that matches TAG.