a first go at capf completion backends for mentions and tags

the regex searches still fail sometimes, and completions don't show urls or
usernames like the old company backends.

2 files changed, 77 insertions, 22 deletions

diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index 31fcae3..fc7bd8e 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -49,13 +49,19 @@
 
 ;; functions for company completion of mentions in mastodon-toot
 
+(defun mastodon-search--get-user-info-@-capf (account)
+  "Get user handle, display name and account URL from ACCOUNT."
+  (list (concat "@" (cdr (assoc 'acct account)))
+        (cdr (assoc 'url account))
+        (cdr (assoc 'display_name account))))
+
 (defun mastodon-search--get-user-info-@ (account)
   "Get user handle, display name and account URL from ACCOUNT."
   (list (cdr (assoc 'display_name account))
         (concat "@" (cdr (assoc 'acct account)))
         (cdr (assoc 'url account))))
 
-(defun mastodon-search--search-accounts-query (query)
+(defun mastodon-search--search-accounts-query (query &optional capf)
   "Prompt for a search QUERY and return accounts synchronously.
 Returns a nested list containing user handle, display name, and URL."
   (interactive "sSearch mastodon for: ")
@@ -63,7 +69,9 @@ Returns a nested list containing user handle, display name, and URL."
          (response (if (equal mastodon-toot--completion-style-for-mentions "following")
                        (mastodon-http--get-search-json url query "following=true")
                      (mastodon-http--get-search-json url query))))
-    (mapcar #'mastodon-search--get-user-info-@ response)))
+    (if capf
+        (mapcar #'mastodon-search--get-user-info-@-capf response)
+      (mapcar #'mastodon-search--get-user-info-@ response))))
 
 ;; functions for tags completion:
 
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index f195a87..6ba3a75 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -108,13 +108,14 @@
 (defcustom mastodon-toot--enable-completion
   (if (require 'company nil :noerror) t nil)
   "Whether to enable completion of mentions and hashtags.
-
 Used for completion in toot compose buffer.
-
 This is only used if company mode is installed."
   :group 'mastodon-toot
   :type 'boolean)
 
+(defcustom mastodon-toot--use-company-for-completion t
+  "Whether to use company for completion.")
+
 (defcustom mastodon-toot--completion-style-for-mentions
   (if (require 'company nil :noerror) "following" "off")
   "The company completion style to use for mentions."
@@ -913,6 +914,56 @@ meta fields respectively."
       (annotation (funcall annot-fun arg))
       (meta (funcall meta-fun arg)))))
 
+(defun mastodon-toot-mentions-capf ()
+  "Build a mentions completion backend for `completion-at-point-functions'."
+  (let* ((handle-bounds
+          ;; hack for @handles@with.domains, as "@" is not inc in any thing at pt!
+          (save-match-data
+            (save-excursion
+              ;; match full handle inc. domain (see the regex for subexp 2)
+              (when (re-search-backward mastodon-toot-handle-regex nil :no-error)
+                ;; (when (match-string-no-properties 2)
+                (cons (match-beginning 2)
+                      (match-end 2))))))
+         (start (car handle-bounds))
+         (end (cdr handle-bounds)))
+    (when handle-bounds
+      (list start
+            end
+            ;; only search when necessary:
+            (completion-table-dynamic
+             (lambda (_)
+               (mastodon-search--search-accounts-query
+                (buffer-substring-no-properties start end)
+                :capf)))
+            :exclusive 'no))))
+
+(defun mastodon-toot-tags-capf ()
+  "Build a tags completion backend for `completion-at-point-functions'."
+  (let* ((tag-bounds
+          (save-match-data
+            (save-excursion
+              ;; match full tag with # (see regex for subexp)
+              (re-search-backward mastodon-toot-tag-regex nil :no-error)
+              (when (match-string-no-properties 2)
+                (cons (match-beginning 2)
+                      (match-end 2))))))
+         (start (car tag-bounds))
+         (end (cdr tag-bounds)))
+    (when tag-bounds
+      (list start
+            end
+            ;; only search when necessary:
+            (completion-table-dynamic
+             (lambda (_)
+               (let ((tags (mastodon-search--search-tags-query
+                            (buffer-substring-no-properties start end))))
+                 (mapcar (lambda (x)
+                           (list (concat "#" (car x))
+                                 (cdr x)))
+                         tags))))
+            :exclusive 'no))))
+
 (defun mastodon-toot-mentions (command &optional arg &rest ignored)
   "A company completion backend for toot mentions.
 COMMAND is either prefix, to fetch a prefix query, candidates, to
@@ -1475,24 +1526,20 @@ a draft into the buffer."
       ;; no need to fetch from `mastodon-profile-account-settings' as
       ;; `mastodon-toot--max-toot-chars' is set when we set it
       (mastodon-toot--get-max-toot-chars))
-    ;; set up completion backends:
-    (when (require 'company nil :noerror)
-      (when mastodon-toot--enable-completion
-        ;; convert our company backends into capfs for use with corfu:
-        ;; FIXME replace this with a customize
-        (if (and (require 'cape nil :noerror)
-                 (bound-and-true-p corfu-mode))
-            (dolist (company-backend (list #'mastodon-toot-tags #'mastodon-toot-mentions))
-              (add-hook 'completion-at-point-functions
-                        (cape-company-to-capf company-backend)
-                        nil
-                        'local))
-          ;; else stick with company:
-          (set (make-local-variable 'company-backends)
-               (add-to-list 'company-backends 'mastodon-toot-mentions))
-          (add-to-list 'company-backends 'mastodon-toot-tags))
-        (unless (bound-and-true-p corfu-mode) ; don't clash w corfu mode
-          (company-mode-on))))
+    ;; set up completion:
+    (when mastodon-toot--enable-completion
+      ;; (setq-local
+      (set
+       (make-local-variable 'completion-at-point-functions)
+       (add-to-list
+        'completion-at-point-functions
+        #'mastodon-toot-mentions-capf))
+      (add-to-list
+       'completion-at-point-functions
+       #'mastodon-toot-tags-capf)
+      (when mastodon-toot--use-company-for-completion
+        (company-mode-on)))
+    ;; after-change:
     (make-local-variable 'after-change-functions)
     (push #'mastodon-toot--update-status-fields after-change-functions)
     (mastodon-toot--refresh-attachments-display)