diff options
| -rw-r--r-- | lisp/mastodon-search.el | 16 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 40 |
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) |