diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-search.el | 19 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 127 |
2 files changed, 128 insertions, 18 deletions
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index f83cccb..7ff8b07 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -49,21 +49,29 @@ ;; 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: ") (let* ((url (mastodon-http--api "accounts/search")) (response (if (equal mastodon-toot--completion-style-for-mentions "following") - (mastodon-http--get-json url `(("q" . ,query) ("following" . "true"))) - (mastodon-http--get-json url `(("q" . ,query)))))) - (mapcar #'mastodon-search--get-user-info-@ response))) + (mastodon-http--get-json url `(("q" . ,query) ("following" . "true")) :silent) + (mastodon-http--get-json url `(("q" . ,query)) :silent)))) + (if capf + (mapcar #'mastodon-search--get-user-info-@-capf response) + (mapcar #'mastodon-search--get-user-info-@ response)))) ;; functions for tags completion: @@ -72,10 +80,9 @@ Returns a nested list containing user handle, display name, and URL." QUERY is the string to search." (interactive "sSearch for hashtag: ") (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - ;; (type-param '(("type" . "hashtags"))) (params `(("q" . ,query) ("type" . "hashtags"))) - (response (mastodon-http--get-json url params)) + (response (mastodon-http--get-json url params :silent)) (tags (alist-get 'hashtags response))) (mapcar #'mastodon-search--get-hashtag-info tags))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7211183..8e6f4df 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -108,13 +108,26 @@ (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 nil + "Whether to use company completion backends directly. +When non-nil, company backends `mastodon-toot-mentions' and +`mastodon-toot-tags' are used for completion. + +A nil setting will use `completion-at-point-functions' for +completion, which also work with company, provided that the +backend `company-capf' is enabled. + +If setting this to non-nil, ensure `corfu-mode' is disabled as the +two are incompatible. + +When the `completion-at-point-functions' backends are more +complete, direct company backends will be removed.") + (defcustom mastodon-toot--completion-style-for-mentions (if (require 'company nil :noerror) "following" "off") "The company completion style to use for mentions." @@ -204,6 +217,13 @@ send.") "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) +(defvar mastodon-toot-tag-regex + (concat + ;; preceding space or bol [boundary doesn't work with #] + "\\([\n\t ]\\|^\\)" + "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag + "\\b")) ; boundary + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -909,6 +929,79 @@ meta fields respectively." (annotation (funcall annot-fun arg)) (meta (funcall meta-fun arg))))) +(defun mastodon-toot--get-bounds (regex) + "Get bounds of tag or handle before point." + ;; needed because # and @ are not part of any existing thing at point + (save-match-data + (save-excursion + ;; match full handle inc. domain, or tag including # + ;; (see the regexes for subexp 2) + (when (re-search-backward regex nil :no-error) + (cons (match-beginning 2) + (match-end 2)))))) + +(defun mastodon-toot--mentions-capf () + "Build a mentions completion backend for `completion-at-point-functions'." + (let* ((bounds + (mastodon-toot--get-bounds mastodon-toot-handle-regex)) + (start (car bounds)) + (end (cdr bounds))) + (when bounds + (list start + end + ;; only search when necessary: + (completion-table-dynamic + (lambda (_) + ;; TODO: do we really need to set a local var here + ;; just for the annotation-function? + (setq mastodon-toot-completions + (mastodon-search--search-accounts-query + (buffer-substring-no-properties start end) + :capf)))) + :exclusive 'no + :annotation-function + (lambda (candidate) + (concat " " + (mastodon-toot--mentions-annotation-fun candidate))))))) + +(defun mastodon-toot--tags-capf () + "Build a tags completion backend for `completion-at-point-functions'." + (let* ((bounds + (mastodon-toot--get-bounds mastodon-toot-tag-regex)) + (start (car bounds)) + (end (cdr bounds))) + (when bounds + (list start + end + ;; only search when necessary: + (completion-table-dynamic + (lambda (_) + (setq mastodon-toot-completions + (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 + :annotation-function + (lambda (candidate) + (concat " " + (mastodon-toot--tags-annotation-fun candidate))))))) + +(defvar-local mastodon-toot-completions nil + "The data of completion candidates for the current completion at point.") + +(defun mastodon-toot--mentions-annotation-fun (candidate) + "Given a handle completion CANDIDATE, return its annotation string, a username." + (caddr (assoc candidate mastodon-toot-completions))) + +(defun mastodon-toot--tags-annotation-fun (candidate) + "Given a tag string CANDIDATE, return an annotation, the tag's URL." + ;; FIXME check the list returned here? should be cadr + ;;or make it an alist and use cdr + (caadr (assoc candidate mastodon-toot-completions))) + (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 @@ -1418,13 +1511,12 @@ Added to `after-change-functions'." ;; stops all text after a handle or mention being propertized: (set-text-properties (cdr header-region) (point-max) nil) ;; TODO: confirm allowed hashtag/handle characters: - (mastodon-toot--propertize-item "\\([\n\t ]\\|^\\)\\(?2:#[1-9a-zA-Z_]+\\)\\b" + (mastodon-toot--propertize-item mastodon-toot-tag-regex 'success (cdr header-region)) - (mastodon-toot--propertize-item - mastodon-toot-handle-regex - 'mastodon-display-name-face - (cdr header-region))))) + (mastodon-toot--propertize-item mastodon-toot-handle-regex + 'mastodon-display-name-face + (cdr header-region))))) (defun mastodon-toot--propertize-item (regex face start) "Propertize item matching REGEX with FACE starting from START." @@ -1472,14 +1564,25 @@ 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 company backends: - (when (require 'company nil :noerror) - (when mastodon-toot--enable-completion + ;; set up completion: + (when mastodon-toot--enable-completion + (if (not mastodon-toot--use-company-for-completion) + ;; capf + (progn + (set ; (setq-local + (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)) + ;; 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 + (add-to-list 'company-backends 'mastodon-toot-tags) (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) |