diff options
| -rw-r--r-- | lisp/mastodon-search.el | 19 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 53 |
2 files changed, 72 insertions, 0 deletions
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 537a746..14e40d8 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -43,6 +43,25 @@ (defvar mastodon-tl--link-keymap) (defvar mastodon-http--timeout) +;; functions for company completion of mentions in mastodon-toot + +(defun mastodon-search--get-user-info-no-url (account) + "Get user handle, display name and account URL from ACCOUNT." + (list (cdr (assoc 'display_name account)) + (cdr (assoc 'acct account)))) + +(defun mastodon-search--search-accounts-query (query) + "Prompt for a search QUERY and return accounts. +Returns a nested list containing user handle, display name, and URL." + (interactive "sSearch mastodon for: ") + (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) + (buffer (format "*mastodon-search-%s*" query)) + (response (mastodon-http--get-search-json url query))) + (mapcar #'mastodon-search--get-user-info-no-url ;-handle-flat-propertized + response))) + +;; functions for mastodon search + (defun mastodon-search--search-query (query) "Prompt for a search QUERY and return accounts, statuses, and hashtags." (interactive "sSearch mastodon for: ") diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index ec5a8ac..4215dec 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -35,6 +35,9 @@ (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) +(require 'cl-lib) +(require 'company nil :noerror) + (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") @@ -53,6 +56,7 @@ (autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-search--search-accounts-query "mastodon-search") (defgroup mastodon-toot nil "Tooting in Mastodon." @@ -75,6 +79,12 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :group 'mastodon-toot :type 'string) +(when (require 'company nil :noerror) + (defcustom mastodon-toot--use-company-completion-for-mentions t + "Whether to enable company completion for mentions in toot compose buffer." + :group 'mastodon-toot + :type 'boolean)) + (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) @@ -371,6 +381,46 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (reverse (append mentions nil)) ""))) +;; (defun mastodon-toot--mentions-company-meta (candidate) +;; (format "meta %s of candidate %s" +;; (get-text-property 0 'meta candidate) +;; (substring-no-properties candidate))) + +(defun mastodon-toot--mentions-company-annotation (candidate) + "Construct a company completion CANDIDATE's annotation for display." + (format " %s" (get-text-property 0 'meta candidate))) + +(defun mastodon-toot--mentions-company-candidates (prefix) + "Given a company PREFIX, build a list of candidates. +The prefix string is tested against both user handles and display names." + (let (res) + (dolist (item (mastodon-search--search-accounts-query prefix)) + (when (or (string-prefix-p prefix (cadr item)) + (string-prefix-p prefix (car item))) + (push (mastodon-toot--mentions-company-make-candidate item) res))) + res)) + +(defun mastodon-toot--mentions-company-make-candidate (candidate) + "Construct a company completion CANDIDATE for display." + (let ((display-name (car candidate)) + (handle (cadr candidate))) + (propertize handle 'meta display-name))) + +(defun mastodon-toot--mentions-company-backend (command &optional arg &rest ignored) + "A company completion backend for toot mentions." + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'mastodon-toot--mentions-company-backend)) + (prefix (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (backward-word) + (backward-char) + (looking-at "@")) ; if we have a mention + (company-grab-symbol))) ;; get thing before point, sans @ + (candidates (mastodon-toot--mentions-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) @@ -627,6 +677,9 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) + (when mastodon-toot--use-company-completion-for-mentions + (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend) + (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) |