implement tags company completion

2 files changed, 52 insertions, 4 deletions

diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index cbb1fba..5756ae4 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -59,12 +59,22 @@
 Returns a nested list containing user handle, display name, and URL."
   (interactive "sSearch mastodon for: ")
   (let* ((url (mastodon-http--api "accounts/search"))
-         ;; (buffer (format "*mastodon-search-%s*" query))
          (response (if (equal mastodon-toot--enable-completion-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)))
+    (mapcar #'mastodon-search--get-user-info-@ response)))
+
+;; functions for tags completion:
+
+(defun mastodon-search--search-tags-query (query)
+  "Return an alist containing tag strings plus their URLs.
+QUERY is the string to search."
+  (interactive "sSearch for hashtag: ")
+  (let* ((url (format "%s/api/v2/search" mastodon-instance-url))
+         (type-param (concat "type=hashtags"))
+         (response (mastodon-http--get-search-json url query type-param))
+         (tags (alist-get 'hashtags response)))
+    (mapcar #'mastodon-search--get-hashtag-info tags)))
 
 ;; functions for mastodon search
 
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 0e26bb2..b3de461 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -645,6 +645,43 @@ candidate ARG. IGNORED remains a mystery."
     (annotation (mastodon-toot--mentions-company-annotation arg))
     (meta (mastodon-toot--mentions-company-meta arg))))
 
+(defun mastodon-toot--tags-company-candidates (prefix)
+  "Given a company PREFIX query, build a list of candidates.
+The prefix can match against both user handles and display names."
+  (let ((prefix (substring prefix 1)) ;remove # for search
+        (res))
+    (dolist (item (mastodon-search--search-tags-query prefix))
+      (when (or (string-prefix-p prefix (substring (cadr item) 1) t)
+                (string-prefix-p prefix (car item) t))
+        (push (mastodon-toot--tags-company-make-candidate item) res)))
+    res))
+
+(defun mastodon-toot--tags-company-make-candidate (candidate)
+  "Construct a company completion CANDIDATE for display."
+  (let ((tag (concat "#" (car candidate)))
+        (url (cadr candidate)))
+    (propertize tag 'annot url 'meta url)))
+
+(defun mastodon-toot-tags (command &optional arg &rest ignored)
+  "A company completion backend for toot mentions.
+COMMAND is either prefix, to fetch a prefix query, candidates, to
+build a list of candidates with query ARG, annotation, to format
+an annotation for candidate ARG, or meta, to format meta info for
+candidate ARG. IGNORED remains a mystery."
+  (interactive (list 'interactive))
+  (cl-case command
+    (interactive (company-begin-backend 'mastodon-toot-tags))
+    (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode
+                       (save-excursion
+                         (forward-whitespace -1)
+                         (forward-whitespace 1)
+                         (looking-at "#")))
+              ;; # + thing before point
+              (concat "#" (company-grab-symbol))))
+    (candidates (mastodon-toot--tags-company-candidates arg))
+    (annotation (mastodon-toot--mentions-company-annotation arg))
+    (meta (mastodon-toot--mentions-company-meta arg))))
+
 (defun mastodon-toot--reply ()
   "Reply to toot at `point'."
   (interactive)
@@ -967,7 +1004,8 @@ REPLY-JSON is the full JSON of the toot being replied to."
     (when (require 'company nil :noerror)
       (when mastodon-toot--enable-completion-for-mentions
         (set (make-local-variable 'company-backends)
-             (add-to-list 'company-backends 'mastodon-toot-mentions))
+             (add-to-list 'company-backends 'mastodon-toot-mentions)
+             (add-to-list 'company-backends 'mastodon-toot-tags))
         (company-mode-on)))
     (make-local-variable 'after-change-functions)
     (push #'mastodon-toot--update-status-fields after-change-functions)