Merge branch 'develop'

6 files changed, 215 insertions, 73 deletions

diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index 4324e1b..0d11fb4 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -48,6 +48,7 @@
 (autoload 'mastodon-tl--spoiler "mastodon-tl.el")
 (autoload 'mastodon-tl--toot-id "mastodon-tl.el")
 (autoload 'mastodon-http--get-params-async-json "mastodon-http.el")
+(autoload 'mastodon-profile--view-follow-requests "mastodon-profile.el")
 (defvar mastodon-tl--buffer-spec)
 (defvar mastodon-tl--display-media-p)
 (defvar mastodon-tl--buffer-spec)
@@ -219,7 +220,9 @@ Status notifications are given when
                (equal type 'boost))
        status))))
 
-(defun mastodon-notifications--insert-status (toot body author-byline action-byline id &optional parent-toot)
+(defun mastodon-notifications--insert-status (toot body
+                                                   author-byline action-byline id
+                                                   &optional parent-toot)
   "Display the content and byline of timeline element TOOT.
 
 BODY will form the section of the toot above the byline.
diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el
index f7a46d5..4b541fd 100644
--- a/lisp/mastodon-profile.el
+++ b/lisp/mastodon-profile.el
@@ -4,7 +4,7 @@
 ;; Author: Johnson Denen <johnson.denen@gmail.com>
 ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
 ;; Version: 1.0.0
-;; Package-Requires: ((emacs "27.1") (seq "1.0"))
+;; Package-Requires: ((emacs "27.1"))
 ;; Homepage: https://codeberg.org/martianh/mastodon.el
 
 ;; This file is not part of GNU Emacs.
@@ -65,7 +65,7 @@
 (autoload 'mastodon-tl--goto-first-item "mastodon-tl")
 (autoload 'mastodon-toot "mastodon")
 (autoload 'mastodon-search--insert-users-propertized "mastodon-search")
-
+(autoload 'mastodon-tl--get-endpoint "mastodon-tl.el")
 (defvar mastodon-instance-url)
 (defvar mastodon-tl--buffer-spec)
 (defvar mastodon-tl--update-point)
@@ -78,7 +78,7 @@
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "s") #'mastodon-profile--open-followers)
     (define-key map (kbd "g") #'mastodon-profile--open-following)
-    (define-key map (kbd "C-c C-c") #'mastodon-profile--account-view-cycle)
+    (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle)
     map)
   "Keymap for `mastodon-profile-mode'.")
 
diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el
index a1bc2dd..8d450e3 100644
--- a/lisp/mastodon-search.el
+++ b/lisp/mastodon-search.el
@@ -40,7 +40,7 @@
 (autoload 'mastodon-auth--access-token "mastodon-auth")
 (autoload 'mastodon-http--get-search-json "mastodon-http")
 (autoload 'mastodon-http--api "mastodon-http")
-
+(defvar mastodon-toot--completion-style-for-mentions)
 (defvar mastodon-instance-url)
 (defvar mastodon-tl--link-keymap)
 (defvar mastodon-http--timeout)
@@ -59,12 +59,22 @@
 Returns a nested list containing user handle, display name, and URL."
   (interactive "sSearch mastodon for: ")
   (let* ((url (mastodon-http--api "accounts/search"))
-         ;; (buffer (format "*mastodon-search-%s*" query))
-         (response (if (equal mastodon-toot--enable-completion-for-mentions "following")
+         (response (if (equal mastodon-toot--completion-style-for-mentions "following")
                        (mastodon-http--get-search-json url query "following=true")
                      (mastodon-http--get-search-json url query))))
-    (mapcar #'mastodon-search--get-user-info-@
-            response)))
+    (mapcar #'mastodon-search--get-user-info-@ response)))
+
+;; functions for tags completion:
+
+(defun mastodon-search--search-tags-query (query)
+  "Return an alist containing tag strings plus their URLs.
+QUERY is the string to search."
+  (interactive "sSearch for hashtag: ")
+  (let* ((url (format "%s/api/v2/search" mastodon-instance-url))
+         (type-param (concat "type=hashtags"))
+         (response (mastodon-http--get-search-json url query type-param))
+         (tags (alist-get 'hashtags response)))
+    (mapcar #'mastodon-search--get-hashtag-info tags)))
 
 ;; functions for mastodon search
 
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 4b81a3b..45e7282 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -512,14 +512,17 @@ E.g. this could return something like \"1 min ago\", \"yesterday\", etc.
 TIME-STAMP is assumed to be in the past."
   (car (mastodon-tl--relative-time-details timestamp current-time)))
 
-(defun mastodon-tl--byline (toot author-byline action-byline)
+(defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p)
   "Generate byline for TOOT.
 
 AUTHOR-BYLINE is a function for adding the author portion of
 the byline that takes one variable.
 ACTION-BYLINE is a function for adding an action, such as boosting,
 favouriting and following to the byline. It also takes a single function.
-By default it is `mastodon-tl--byline-boosted'"
+By default it is `mastodon-tl--byline-boosted'.
+
+DETAILED-P means display more detailed info. For now
+this just means displaying toot client."
   (let* ((created-time
           ;; bosts and faves in notifs view
           ;; (makes timestamps be for the original toot
@@ -574,6 +577,21 @@ By default it is `mastodon-tl--byline-boosted'"
         'display (if mastodon-tl--enable-relative-timestamps
                      (mastodon-tl--relative-time-description parsed-time)
                    parsed-time))
+       (when detailed-p
+         (let* ((app (alist-get 'application toot))
+                (app-name (alist-get 'name app))
+                (app-url (alist-get 'website app)))
+           (when app
+             (concat
+              (propertize " via " 'face 'default)
+              (propertize app-name
+                          'face 'mastodon-display-name-face
+                          'follow-link t
+                          'mouse-face 'highlight
+		          'mastodon-tab-stop 'shr-url
+		          'shr-url app-url
+                          'help-echo app-url
+		          'keymap mastodon-tl--shr-map-replacement)))))
        (propertize "\n  ------------\n" 'face 'default))
       'favourited-p faved
       'boosted-p    boosted
@@ -875,7 +893,8 @@ Runs `mastodon-tl--render-text' and fetches poll or media."
        (mastodon-tl--get-poll toot))
      (mastodon-tl--media toot))))
 
-(defun mastodon-tl--insert-status (toot body author-byline action-byline &optional id parent-toot)
+(defun mastodon-tl--insert-status (toot body author-byline action-byline
+                                        &optional id parent-toot detailed-p)
   "Display the content and byline of timeline element TOOT.
 
 BODY will form the section of the toot above the byline.
@@ -889,14 +908,17 @@ takes a single function. By default it is
 
 ID is that of the toot, which is attached as a property if it is
 a notification. If the status is a favourite or a boost,
-PARENT-TOOT is the JSON of the toot responded to."
+PARENT-TOOT is the JSON of the toot responded to.
+
+DETAILED-P means display more detailed info. For now
+this just means displaying toot client."
   (let ((start-pos (point)))
     (insert
      (propertize
       (concat "\n"
               body
               " \n"
-              (mastodon-tl--byline toot author-byline action-byline))
+              (mastodon-tl--byline toot author-byline action-byline detailed-p))
       'toot-id      (or id ; for notifications
                         (alist-get 'id toot))
       'base-toot-id (mastodon-tl--toot-id
@@ -1027,8 +1049,11 @@ in which case play first video or gif from current toot."
           (message "no moving image here?"))
       (message "no moving image here?"))))
 
-(defun mastodon-tl--toot (toot)
-  "Formats TOOT and insertes it into the buffer."
+(defun mastodon-tl--toot (toot &optional detailed-p)
+  "Formats TOOT and insertes it into the buffer.
+
+DETAILED-P means display more detailed info. For now
+this just means displaying toot client."
   (mastodon-tl--insert-status
    toot
    (mastodon-tl--clean-tabs-and-nl
@@ -1036,7 +1061,10 @@ in which case play first video or gif from current toot."
         (mastodon-tl--spoiler toot)
       (mastodon-tl--content toot)))
    'mastodon-tl--byline-author
-   'mastodon-tl--byline-boosted))
+   'mastodon-tl--byline-boosted
+   nil
+   nil
+   detailed-p))
 
 (defun mastodon-tl--timeline (toots)
   "Display each toot in TOOTS."
@@ -1144,11 +1172,39 @@ webapp"
         (reblog (alist-get 'reblog json)))
     (if reblog (alist-get 'id reblog) id)))
 
+(defun mastodon-tl--single-toot (&optional id)
+  "View toot at point in separate buffer.
+ID is that of the toot to view."
+  (interactive)
+  (let* ((id
+          (or id
+              (if (equal (mastodon-tl--get-endpoint) "notifications")
+                  ;; for boosts/faves:
+                  (if (mastodon-tl--property 'parent-toot)
+                      (mastodon-tl--as-string (mastodon-tl--toot-id
+                                               (mastodon-tl--property 'parent-toot)))
+                    (mastodon-tl--property 'base-toot-id))
+                (mastodon-tl--property 'base-toot-id))))
+         (buffer (format "*mastodon-toot-%s*" id))
+         (toot (mastodon-http--get-json
+                (mastodon-http--api (concat "statuses/" id)))))
+    (with-output-to-temp-buffer buffer
+      (switch-to-buffer buffer)
+      (mastodon-mode)
+      (setq mastodon-tl--buffer-spec
+            `(buffer-name ,buffer
+                          endpoint ,(format "statuses/%s" id)
+                          update-function
+                          (lambda (toot) (message "END of thread."))))
+      (let ((inhibit-read-only t))
+        (mastodon-tl--toot toot :detailed-p)))))
+
 (defun mastodon-tl--thread ()
   "Open thread buffer for toot under `point'."
   (interactive)
   (let* ((id
           (if (equal (mastodon-tl--get-endpoint) "notifications")
+              ;; for boosts/faves:
               (if (mastodon-tl--property 'parent-toot)
                   (mastodon-tl--as-string (mastodon-tl--toot-id
                                            (mastodon-tl--property 'parent-toot)))
@@ -1176,12 +1232,12 @@ webapp"
                                 update-function
                                 (lambda (toot) (message "END of thread."))))
             (let ((inhibit-read-only t))
-              (mastodon-tl--timeline (vconcat
-                                      (alist-get 'ancestors context)
-                                      `(,toot)
-                                      (alist-get 'descendants context)))))
+              (mastodon-tl--timeline (alist-get 'ancestors context))
+              (goto-char (point-max))
+              (mastodon-tl--toot toot :detailed-p)
+              (mastodon-tl--timeline (alist-get 'descendants context))))
           (mastodon-tl--goto-next-toot))
-      (message "No Thread!"))))
+      (mastodon-tl--single-toot id))))
 
 (defun mastodon-tl--create-filter ()
   "Create a filter for a word.
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)
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 842738e..9400014 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -5,7 +5,7 @@
 ;; Author: Johnson Denen <johnson.denen@gmail.com>
 ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net>
 ;; Version: 1.0.0
-;; Package-Requires: ((emacs "27.1") (request "0.3.2") (seq "1.0"))
+;; Package-Requires: ((emacs "27.1") (request "0.3.0"))
 ;; Homepage: https://codeberg.org/martianh/mastodon.el
 
 ;; This file is not part of GNU Emacs.
@@ -88,7 +88,8 @@
 (autoload 'mastodon-profile--view-bookmarks "mastodon-profile")
 (autoload 'mastoton-tl--view-filters "mastodon-tl")
 ;; (autoload 'mastodon-toot--bookmark-toot-toggle "mastodon-toot")
-
+(autoload 'mastodon-tl--view-filters "mastodon-tl")
+(autoload 'mastodon-tl--get-follow-suggestions "mastodon-tl")
 (when (require 'lingva nil :no-error)
   (autoload 'mastodon-toot--translate-toot-text "mastodon-toot"))