From 945123851999405c493196a1ce85d5f88f609410 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 5 Dec 2023 18:32:36 +0100 Subject: start on emoji-capf for compose buffer --- lisp/mastodon-toot.el | 57 +++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 48 insertions(+), 9 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7833e47..65268e3 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-emoji-tag-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,21 +1021,25 @@ 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." ;; 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))))) + (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--mentions-capf () "Build a mentions completion backend for `completion-at-point-functions'." @@ -1069,6 +1081,26 @@ If TAGS, we search for tags, else we search for handles." (lambda (cand) (concat " " (mastodon-toot--tags-annotation-fun cand))))))) +(defun mastodon-toot--emoji-capf () + "Build an emoji completion backend for `completion-at-point-functions'." + (let* ((bounds (mastodon-toot--get-bounds mastodon-emoji-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 :emoji)))) + (and (consp result) result)))) + :exclusive 'no + :annotation-function + (lambda (cand) + (concat " " (mastodon-toot--emoji-annotation-fun cand))))))) + (defun mastodon-toot--mentions-annotation-fun (candidate) "Given a handle completion CANDIDATE, return its annotation string, a username." (caddr (assoc candidate mastodon-toot-completions))) @@ -1079,6 +1111,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 @@ -1816,6 +1853,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)) -- cgit v1.2.3 From 0c7322e839f76882a4993516c5921c8ee82e25fa Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 19 Dec 2023 21:52:42 +0100 Subject: refactor mastodon-toot--make-capf --- lisp/mastodon-toot.el | 63 +++++++++++++++++++-------------------------------- 1 file changed, 23 insertions(+), 40 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 65268e3..14bc7db 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -1024,7 +1024,7 @@ Federated user: `username@host.co`." (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 @@ -1041,9 +1041,13 @@ If TAGS, we search for tags, else we search for handles." (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)) +(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 @@ -1054,52 +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'." - (let* ((bounds (mastodon-toot--get-bounds mastodon-emoji-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 :emoji)))) - (and (consp result) result)))) - :exclusive 'no - :annotation-function - (lambda (cand) - (concat " " (mastodon-toot--emoji-annotation-fun cand))))))) + (mastodon-toot--make-capf mastodon-emoji-tag-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." -- cgit v1.2.3 From 638e5e09dfcafde824c74d277089fd66fb3c959a Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 19 Dec 2023 21:59:37 +0100 Subject: clean up emoji capf --- lisp/mastodon-toot.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 14bc7db..0d7e932 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -239,7 +239,7 @@ send.") (group-n 2 ?# (+ (any "A-Z" "a-z" "0-9"))) (| "'" word-boundary))) ; boundary or possessive -(defvar mastodon-emoji-tag-regex +(defvar mastodon-toot-emoji-regex (rx (| (any ?\( "\n" "\t" " ") bol) (group-n 2 ?: ; opening : (+ (any "A-Z" "a-z" "0-9" "_")) @@ -1044,7 +1044,7 @@ TYPE is the candidate type, it may be :tags, :handles, or :emoji." (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'. +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)) @@ -1080,7 +1080,7 @@ arg, a candidate." (defun mastodon-toot--emoji-capf () "Build an emoji completion backend for `completion-at-point-functions'." - (mastodon-toot--make-capf mastodon-emoji-tag-regex + (mastodon-toot--make-capf mastodon-toot-emoji-regex #'mastodon-toot--emoji-annotation-fun :emoji)) @@ -1094,10 +1094,10 @@ arg, a candidate." ;; or make it an alist and use cdr (cadr (assoc candidate mastodon-toot-completions))) -(defun mastodon-toot--emoji-annotation-fun (candidate) - "" +(defun mastodon-toot--emoji-annotation-fun (_candidate) + "." ;; TODO: emoji image as annot -) + ) ;;; REPLY -- cgit v1.2.3