[elpa] externals/devdocs 783e9a6d4b: Use a visible marking for entry disambiguation

[ELPA Syncer]

branch: externals/devdocs
commit 783e9a6d4b0a36dfb646e3b9dad19c54018f7195
Author: Augusto Stoffel <arstoffel@gmail.com>
Commit: Augusto Stoffel <arstoffel@gmail.com>

    Use a visible marking for entry disambiguation
    
    The marking style is specified by `devdocs-disambiguated-entry-format'.
    In particular, it can be made invisible, as it used to be.
---
 devdocs.el | 57 ++++++++++++++++++++++++++++++---------------------------
 1 file changed, 30 insertions(+), 27 deletions(-)

diff --git a/devdocs.el b/devdocs.el
index cf6508f09b..767b8a7f35 100644
--- a/devdocs.el
+++ b/devdocs.el
@@ -75,6 +75,16 @@ directory-local variable."
   "String used to format a documentation location, e.g. in header line."
   :type 'string)
 
+(defcustom devdocs-disambiguated-entry-format #("%s (%s)" 3 7 (face italic))
+  "How to disambiguate entries with identical names in `devdocs-lookup'.
+This string is passed to `format' with two arguments, the entry
+name and a count."
+  :type '(choice (const :tag "Count in parentheses, italicized"
+                        #("%s (%s)" 3 7 (face italic)))
+                 (const :tag "Invisible cookie"
+                        #("%s (%s)" 2 7 (invisible t)))
+                 string))
+
 (defcustom devdocs-fontify-code-blocks t
   "Whether to fontify code snippets inside pre tags.
 Fontification is done using the `org-src' library, which see."
@@ -451,20 +461,26 @@ ARGS is passed as is to `browse-url'."
 
 (defun devdocs--entries (documents)
   "A list of entries in DOCUMENTS, as propertized strings."
-  (let* ((cookie #x10FFFF) ;; Disambiguate entries with identical names
-         (fmtcand (lambda (it)
-                    (setq cookie (1+ cookie))
-                    (concat (alist-get 'name it)
-                            (propertize (string cookie)
-                                        'invisible t
-                                        'devdocs--data it)))))
-    (mapcan (lambda (doc)
-              (mapcar fmtcand (alist-get 'entries (devdocs--index doc))))
-             documents)))
+  (let* ((counts (make-hash-table :test 'equal))
+         (mkentry (lambda (it)
+                    (let* ((name (alist-get 'name it))
+                           (count (1+ (gethash name counts 0))))
+                      (puthash name count counts)
+                      `(,name ,count . ,it))))
+         (entries (mapcan (lambda (doc)
+                            (mapcar mkentry
+                                    (alist-get 'entries (devdocs--index doc))))
+                          documents)))
+    (mapcar (pcase-lambda (`(,name ,count . ,it))
+              (propertize (if (= 1 (gethash name counts))
+                              name
+                            (format devdocs-disambiguated-entry-format name 
count))
+                          'devdocs--data it))
+            entries)))
 
 (defun devdocs--get-data (str)
   "Get data stored as a string property in STR."
-  (get-text-property (1- (length str)) 'devdocs--data str))
+  (get-text-property 0 'devdocs--data str))
 
 (defun devdocs--annotate (cand)
   "Return an annotation for `devdocs--read-entry' candidate CAND."
@@ -472,16 +488,6 @@ ARGS is passed as is to `browse-url'."
     (concat " " (propertize " " 'display '(space :align-to 40))
      (devdocs--doc-title .doc) devdocs-separator .type)))
 
-(defun devdocs--eat-cookie (&rest _)
-  "Eat the disambiguation cookie in the minibuffer."
-  (save-excursion
-    (goto-char (minibuffer-prompt-end))
-    (while (and (not (eobp)) (<= (char-after) #x10FFFF))
-      (forward-char))
-    (unless (eobp)
-      (add-text-properties (point) (1+ (point))
-                           '(invisible t rear-nonsticky t)))))
-
 (defun devdocs--relevant-docs (ask)
   "Return a list of relevant documents for the current buffer.
 May ask interactively for the desired documents.  If ASK is
@@ -508,12 +514,9 @@ INITIAL-INPUT is passed to `completing-read'"
                  (if (eq action 'metadata)
                      metadata
                    (complete-with-action action cands string predicate))))
-         (cand (minibuffer-with-setup-hook
-                   (lambda ()
-                     (add-hook 'after-change-functions 'devdocs--eat-cookie 
nil t))
-                   (completing-read prompt coll nil t initial-input
-                                    'devdocs-history
-                                    (thing-at-point 'symbol)))))
+         (cand (completing-read prompt coll nil t initial-input
+                                'devdocs-history
+                                (thing-at-point 'symbol))))
     (devdocs--get-data (car (member cand cands)))))
 
 ;;;###autoload