Merge branch 'develop'

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)