diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-toot.el | 88 |
1 files changed, 55 insertions, 33 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 90cf9a9..c96ee5b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -239,12 +239,20 @@ send.") (group-n 2 ?# (+ (any "A-Z" "a-z" "0-9"))) (| "'" word-boundary))) ; boundary or possessive +(defvar mastodon-toot-emoji-regex + (rx (| (any ?\( "\n" "\t" " ") bol) + (group-n 2 ?: ; opening : + (+ (any "A-Z" "a-z" "0-9" "_")) + (? ?:)) ; closing : + word-boundary)) ; boundary + (defvar mastodon-toot-url-regex ;; adapted from ffap-url-regexp (concat "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix "[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars ;; "[ .,:;!?]\\b")) + ;; "/" ; poss an ending slash? incompat with boundary end: "\\>")) ; boundary end @@ -1013,25 +1021,33 @@ Federated user: `username@host.co`." (cons (match-beginning 2) (match-end 2)))))) -(defun mastodon-toot--fetch-completion-candidates (start end &optional tags) +(defun mastodon-toot--fetch-completion-candidates (start end &optional type) "Search for a completion prefix from buffer positions START to END. Return a list of candidates. -If TAGS, we search for tags, else we search for handles." +TYPE is the candidate type, it may be :tags, :handles, or :emoji." ;; we can't save the first two-letter search then only filter the ;; resulting list, as max results returned is 40. (setq mastodon-toot-completions - (if tags - (let ((tags-list (mastodon-search--search-tags-query - (buffer-substring-no-properties start end)))) - (cl-loop for tag in tags-list - collect (cons (concat "#" (car tag)) - (cdr tag)))) - (mastodon-search--search-accounts-query - (buffer-substring-no-properties start end))))) - -(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)) + (cond ((eq type :tags) + (let ((tags-list (mastodon-search--search-tags-query + (buffer-substring-no-properties start end)))) + (cl-loop for tag in tags-list + collect (cons (concat "#" (car tag)) + (cdr tag))))) + ((eq type :emoji) + (cl-loop for e in emojify-user-emojis + collect (car e))) + (t + (mastodon-search--search-accounts-query + (buffer-substring-no-properties start end)))))) + +(defun mastodon-toot--make-capf (regex type &optional annot-fun) + "Build a completion backend for `completion-at-point-functions'. +REGEX is the regex to match preceding text. +TYPE is a keyword symbol for `mastodon-toot--fetch-completion-candidates'. +ANNOT-FUN is a function returning an annotatation from a single +arg, a candidate." + (let* ((bounds (mastodon-toot--get-bounds regex)) (start (car bounds)) (end (cdr bounds))) (when bounds @@ -1042,32 +1058,31 @@ If TAGS, we search for tags, else we search for handles." ;; Interruptible candidate computation, from minad/d mendler, thanks! (let ((result (while-no-input - (mastodon-toot--fetch-completion-candidates start end)))) + (mastodon-toot--fetch-completion-candidates + start end type)))) (and (consp result) result)))) :exclusive 'no :annotation-function (lambda (cand) - (concat " " (mastodon-toot--mentions-annotation-fun cand))))))) + (concat " " (funcall annot-fun cand))))))) + +(defun mastodon-toot--mentions-capf () + "Build a mentions completion backend for `completion-at-point-functions'." + (mastodon-toot--make-capf mastodon-toot-handle-regex + #'mastodon-toot--mentions-annotation-fun + :handles)) (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 - (completion-table-dynamic ; only search when necessary: - (lambda (_) - ;; Interruptible candidate computation, from minad/d mendler, thanks! - (let ((result - (while-no-input - (mastodon-toot--fetch-completion-candidates start end :tags)))) - (and (consp result) result)))) - :exclusive 'no - :annotation-function - (lambda (cand) - (concat " " (mastodon-toot--tags-annotation-fun cand))))))) + (mastodon-toot--make-capf mastodon-toot-tag-regex + #'mastodon-toot--tags-annotation-fun + :tags)) + +(defun mastodon-toot--emoji-capf () + "Build an emoji completion backend for `completion-at-point-functions'." + (mastodon-toot--make-capf mastodon-toot-emoji-regex + #'mastodon-toot--emoji-annotation-fun + :emoji)) (defun mastodon-toot--mentions-annotation-fun (candidate) "Given a handle completion CANDIDATE, return its annotation string, a username." @@ -1079,6 +1094,11 @@ If TAGS, we search for tags, else we search for handles." ;; or make it an alist and use cdr (cadr (assoc candidate mastodon-toot-completions))) +(defun mastodon-toot--emoji-annotation-fun (_candidate) + "." + ;; TODO: emoji image as annot + ) + ;;; REPLY @@ -1817,6 +1837,8 @@ EDIT means we are editing an existing toot, not composing a new one." #'mastodon-toot--mentions-capf)) (add-to-list 'completion-at-point-functions #'mastodon-toot--tags-capf) + (add-to-list 'completion-at-point-functions + #'mastodon-toot--emoji-capf) ;; company (when (and mastodon-toot--use-company-for-completion (require 'company nil :no-error)) |