branch: externals/taxy
commit 009074563fc443c5bb6337d642001c6328a9c379
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Deffy: Fix: Disambiguate forms with same name
---
README.org | 4 +++-
examples/deffy.el | 20 ++++++++++++++++++--
2 files changed, 21 insertions(+), 3 deletions(-)
diff --git a/README.org b/README.org
index 21d1919692..4160a0844e 100644
--- a/README.org
+++ b/README.org
@@ -935,7 +935,9 @@ In Emacs 28+, see also =M-x shortdoc-display-group RET taxy
RET=.
** 0.10-pre
-Nothing new yet.
+*Examples*
++ Deffy
+ + Fix: Disambiguate forms with the same name.
** 0.9
diff --git a/examples/deffy.el b/examples/deffy.el
index 03524301d4..3126bd0336 100644
--- a/examples/deffy.el
+++ b/examples/deffy.el
@@ -304,7 +304,10 @@ prefix, from all `deffy-mode' buffers."
"Read form selected from Deffy BUFFERS with completion."
(unless deffy-buffers
(user-error "No Deffy buffers to find in"))
- (cl-labels ((def-cons
+ (cl-labels ((disambiguate (string)
+ (format "%s (%s)"
+ string (deffy-def-type (get-text-property
0 :def string))))
+ (def-cons
(def) (cons (propertize
(format "%s" (deffy-def-name def))
:annotation (funcall annotate-fn def)
@@ -345,7 +348,20 @@ prefix, from all `deffy-mode' buffers."
affixation-fn #'affix)))
(let* ((taxys (mapcar #'buffer-taxy deffy-buffers))
(items (mapcan #'taxy-flatten taxys))
- (alist (setf items (mapcar #'def-cons items)))
+ (alist (mapcar #'def-cons items))
+ ;; Unfortunately, `completing-read' always discards text
properties, which
+ ;; means that they can't be used to disambiguate items with the
same name
+ ;; (e.g. `(defthis foo)' in one form and `(defthat foo)' in
another). So we
+ ;; have to check for items with duplicate names, then replace the
string with
+ ;; one that disambiguates them.
+ (duplicates (cl-loop for item in alist
+ when (> (cl-count (car item) alist :key #'car
:test #'equal) 1)
+ collect item))
+ (_ (when duplicates
+ (dolist (dupe duplicates)
+ (setf alist (remove dupe alist)
+ dupe (cons (disambiguate (car dupe)) (cdr dupe)))
+ (push dupe alist))))
(metadata (list 'metadata (cons 'group-function #'group)))
(dynamic-fn (lambda (str pred flag)
(pcase flag
