diff options
Diffstat (limited to 'lisp/mastodon-toot.el')
| -rw-r--r-- | lisp/mastodon-toot.el | 170 |
1 files changed, 121 insertions, 49 deletions
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b89b01e..be3aaad 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -103,14 +103,20 @@ followers-only), or \"direct\"." :group 'mastodon-toot :type 'integer) -(defcustom mastodon-toot--enable-completion-for-mentions - (if (require 'company nil :noerror) "following" "off") - "Whether to enable company completion for mentions. +(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--completion-style-for-mentions + (if (require 'company nil :noerror) "following" "off") + "The company completion style to use for mentions." + :group 'mastodon-toot :type '(choice (const :tag "off" nil) (const :tag "following only" "following") @@ -207,7 +213,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (defun mastodon-toot--action (action callback) "Take ACTION on toot at point, then execute CALLBACK. -Makes a POST request to the server." +Makes a POST request to the server. Used for favouriting, +boosting, or bookmarking toots." (let* ((id (mastodon-tl--property 'base-toot-id)) (url (mastodon-http--api (concat "statuses/" (mastodon-tl--as-string id) @@ -240,11 +247,11 @@ TYPE is a symbol, either 'favourite or 'boost." (if byline-region (cond ;; actually there's nothing wrong with faving/boosting own toots! ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) - ;;(error "You can't %s your own toots." action-string)) + ;;(error "You can't %s your own toots" action-string)) ((equal "reblog" toot-type) - (error "You can't %s boosts." action-string)) + (error "You can't %s boosts" action-string)) ((equal "favourite" toot-type) - (error "Your can't %s favourites." action-string)) + (error "Your can't %s favourites" action-string)) (t (mastodon-toot--action action @@ -275,24 +282,24 @@ TYPE is a symbol, either 'favourite or 'boost." (defun mastodon-toot--bookmark-toot-toggle () "Bookmark or unbookmark toot at point." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--property 'base-toot-id)) - ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (bookmarked-p (mastodon-tl--property 'bookmarked-p)) - (prompt (if bookmarked-p - (format "Toot already bookmarked. Remove? ") - (format "Bookmark this toot? "))) - (byline-region - (when id - (mastodon-tl--find-property-range 'byline (point)))) - (action (if bookmarked-p "unbookmark" "bookmark")) - (bookmark-str (if (fontp (char-displayable-p #10r128278)) - "🔖" - "K")) - (message (if bookmarked-p - "Bookmark removed!" - "Toot bookmarked!")) - (remove (when bookmarked-p t))) + (let* ( ;(toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--property 'base-toot-id)) + ;; (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (bookmarked-p (mastodon-tl--property 'bookmarked-p)) + (prompt (if bookmarked-p + (format "Toot already bookmarked. Remove? ") + (format "Bookmark this toot? "))) + (byline-region + (when id + (mastodon-tl--find-property-range 'byline (point)))) + (action (if bookmarked-p "unbookmark" "bookmark")) + (bookmark-str (if (fontp (char-displayable-p #10r128278)) + "🔖" + "K")) + (message (if bookmarked-p + "Bookmark removed!" + "Toot bookmarked!")) + (remove (when bookmarked-p t))) (if byline-region (when (y-or-n-p prompt) (mastodon-toot--action @@ -402,7 +409,7 @@ NO-REDRAFT means delete toot only." toot-cw))))))))) (defun mastodon-toot-set-cw (&optional cw) - "Set content warning to CW if it is non-nil" + "Set content warning to CW if it is non-nil." (unless (equal cw "") (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft cw))) @@ -606,17 +613,6 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." "Format company completion CANDIDATE's annotation." (format " %s" (get-text-property 0 'annot candidate))) -(defun mastodon-toot--mentions-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-accounts-query prefix)) - (when (or (string-prefix-p prefix (substring (cadr item) 1) t) - (string-prefix-p prefix (car item) t)) - (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)) @@ -624,25 +620,100 @@ The prefix can match against both user handles and display names." (url (caddr candidate))) (propertize handle 'annot display-name 'meta url))) -(defun mastodon-toot-mentions (command &optional arg &rest ignored) - "A company completion backend for toot mentions. +(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--company-build-candidates (query list-fun make-fun) + "Build a list of completion candidates for a company backend. +QUERY is the search prefix, LIST-FUN builds a list of items to +match against, and MAKE-FUN builds the actual cadidate list item +for display by company." + (let ((query (substring query 1)) ; remove @ or # for search + (res)) + (dolist (item (funcall list-fun query)) + (when (or (string-prefix-p query (substring (cadr item) 1) t) + (string-prefix-p query (car item) t)) + (push (funcall make-fun item) res))) + res)) + +(defun mastodon-toot--mentions-company-candidates (query) + "Given a company QUERY, build a list of candidates. +The query can match both user handles and display names." + (mastodon-toot--company-build-candidates + query + 'mastodon-search--search-accounts-query + 'mastodon-toot--mentions-company-make-candidate)) + +(defun mastodon-toot--tags-company-candidates (query) + "Given a company QUERY, build a list of candidates. +The query is matched against a tag search on the server." + (mastodon-toot--company-build-candidates + query + 'mastodon-search--search-tags-query + 'mastodon-toot--tags-company-make-candidate)) + +(defun mastodon-toot--make-company-backend + (command backend-name str-prefix candidates-fun annot-fun meta-fun + &optional arg + &rest ignored) + "Make a company backend for `mastodon-toot-mode'. +COMMAND, ARG, IGNORED are all company backend args. 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." +candidate ARG. IGNORED remains a mystery. + +BACKEND-NAME is the backend's name, STR-PREFIX is used to search +for matches, CANDIDATES-FUN, ANNOT-FUN, and META-FUN are +functions called on ARG to generate formatted candidates, annotation, and +meta fields respectively." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot-mentions)) + (interactive (company-begin-backend (quote backend-name))) (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--mentions-company-candidates arg)) - (annotation (mastodon-toot--mentions-company-annotation arg)) - (meta (mastodon-toot--mentions-company-meta arg)))) + (looking-at str-prefix))) + (concat str-prefix (company-grab-symbol)))) + (candidates (funcall candidates-fun arg)) + (annotation (funcall annot-fun arg)) + (meta (funcall meta-fun arg)))) + +(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 +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." + (mastodon-toot--make-company-backend + command + 'mastodon-toot-mentions + "@" + 'mastodon-toot--mentions-company-candidates + 'mastodon-toot--mentions-company-annotation + 'mastodon-toot--mentions-company-meta + arg + ignored)) + +(defun mastodon-toot-tags (command &optional arg &rest ignored) + "A company completion backend for toot tags. +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." + (mastodon-toot--make-company-backend + command + 'mastodon-toot-tags + "#" + 'mastodon-toot--tags-company-candidates + 'mastodon-toot--mentions-company-annotation + 'mastodon-toot--mentions-company-meta + arg + ignored)) (defun mastodon-toot--reply () "Reply to toot at `point'." @@ -964,10 +1035,11 @@ REPLY-JSON is the full JSON of the toot being replied to." (unless mastodon-toot--max-toot-chars (mastodon-toot--get-max-toot-chars)) (when (require 'company nil :noerror) - (when mastodon-toot--enable-completion-for-mentions + (when mastodon-toot--enable-completion (set (make-local-variable 'company-backends) (add-to-list 'company-backends 'mastodon-toot-mentions)) - (company-mode-on))) + (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) (mastodon-toot--refresh-attachments-display) |