diff options
| -rw-r--r-- | .gitignore | 5 | ||||
| -rw-r--r-- | Cask | 4 | ||||
| -rw-r--r-- | Makefile | 45 | ||||
| -rw-r--r-- | README.org | 30 | ||||
| -rw-r--r-- | dir | 18 | ||||
| -rw-r--r-- | lisp/mastodon-async.el | 9 | ||||
| -rw-r--r-- | lisp/mastodon-auth.el | 11 | ||||
| -rw-r--r-- | lisp/mastodon-client.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-discover.el | 144 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 3 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 7 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 42 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 273 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 20 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 1564 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 533 | ||||
| -rw-r--r-- | lisp/mastodon-views.el | 908 | ||||
| -rw-r--r-- | lisp/mastodon.el | 156 | ||||
| -rw-r--r-- | mastodon.info | 661 | ||||
| -rw-r--r-- | mastodon.texi | 741 | ||||
| -rw-r--r-- | test/ert-helper.el | 2 | ||||
| -rw-r--r-- | test/mastodon-auth-tests.el | 2 | ||||
| -rw-r--r-- | test/mastodon-notifications-tests.el | 17 | ||||
| -rw-r--r-- | test/mastodon-profile-tests.el | 4 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 62 |
25 files changed, 3529 insertions, 1734 deletions
@@ -10,3 +10,8 @@ stubfile.plstore *~ dist/ /mastodon.org + +# ELPA-generted files +/mastodon-pkg.el +/mastodon-autoloads.el +/lisp/mastodon-autoloads.el @@ -8,4 +8,6 @@ (depends-on "ert-runner") (depends-on "el-mock") (depends-on "ecukes") - (depends-on "package-lint")) + (depends-on "package-lint") + (depends-on "elsa") + (depends-on "async")) diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d41aa35 --- /dev/null +++ b/Makefile @@ -0,0 +1,45 @@ +PKG = mastodon + +CP = cp +LN = ln + +EMACS = emacs +MAKEINFO = makeinfo +INSTALL-INFO = install-info +ORG_DIR = $(word 1,$(wildcard $(HOME)/.emacs.d/elpa/org-9*)) +ORG_PATH = -L $(ORG_DIR) +ORG_ARGS = --batch $(ORG_PATH) -l org -l ol-man +ORG_EVAL1 = --funcall org-texinfo-export-to-texinfo +ORG_EVAL2 = --funcall org-texinfo-export-to-info + +## ################################################################ + +.PHONY: clean + +all: $(PKG).info dir + +clean: + rm -f $(PKG).org $(PKG).texi $(PKG).info dir + +## ################################################################ + +# May look at this in the future +# +# %.info: %.texi +# @printf "Generating $@\n" +# $(MAKEINFO) --no-split $< -o $@ +# +# %.texi: %.org +# @printf "Generating $@\n" +# $(EMACS) $(ORG_ARGS) $@ $(ORG_EVAL1) + +%.info: %.org + @printf "Generating $@\n" + $(EMACS) $(ORG_ARGS) $< $(ORG_EVAL2) + +dir: $(PKG).info + printf "Generating $@\n" + echo $^ | xargs -n 1 $(INSTALL-INFO) --dir=$@ + +$(PKG).org: README.org + $(CP) $< $@ @@ -1,3 +1,7 @@ +#+TEXINFO_DIR_CATEGORY: Emacs +#+TEXINFO_DIR_TITLE: Mastodon: (mastodon). +#+TEXINFO_DIR_DESC: Client for Mastodon on ActivityPub networks. + @@html: <a href="https://melpa.org/#/mastodon"><img alt="MELPA" src="https://melpa.org/packages/mastodon-badge.svg"/></a>@@ @@html: <a href="https://ci.codeberg.org/martianh/mastodon.el"><img alt="Build Status" src="https://ci.codeberg.org/api/badges/martianh/mastodon.el/status.svg"></a>@@ @@ -114,8 +118,8 @@ not contain =:client_id= and =:client_secret=. | =?= | Show discover menu of all bindings, if =discover= is available | |----------------+---------------------------------------------------------------------------| | | *Timeline actions* | -| =n= | Go to next item (toot, notification) | -| =p= | Go to previous item (toot, notification) | +| =n= | Go to next item (toot, notification, user) | +| =p= | Go to previous item (toot, notification, user) | | =M-n=/=<tab>= | Go to the next interesting thing that has an action | | =M-p=/=<S-tab>= | Go to the previous interesting thing that has an action | | =F= | Open federated timeline | @@ -131,18 +135,20 @@ not contain =:client_id= and =:client_secret=. | =O= | View own profile | | =U= | update your profile bio note | | =;= | view instance description for toot at point | +| =:= | view followed tags and load a tag timeline | | =,= | view favouriters of toot at point | | =.= | view boosters of toot at point | +| =/= | switch between mastodon buffers | |----------------+---------------------------------------------------------------------------| | | *Other views* | -| =S= | search (posts, users, tags) (NB: only posts you have interacted with) | +| =s= | search (posts, users, tags) (NB: only posts you have interacted with) | | =I=, =c=, =d= | view, create, and delete filters | | =R=, =a=, =j= | view/accept/reject follow requests | | =G= | view follow suggestions | | =V= | view your favourited toots | | =K= | view bookmarked toots | | =X= | view/edit/create/delete lists | -| =s= | view your scheduled toots | +| =S= | view your scheduled toots | |----------------+---------------------------------------------------------------------------| | | *Toot actions* | | =t= | Compose a new toot | @@ -162,7 +168,7 @@ not contain =:client_id= and =:client_secret=. | (=S-C-=) =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | |----------------+---------------------------------------------------------------------------| | | *Profile view* | -| =C-c C-c= | cycle between statuses, followers, following, and statuses without boosts | +| =C-c C-c= | cycle between statuses, statuses without boosts, followers, and following | | | =mastodon-profile--account-account-to-list= (see lists view) | |----------------+---------------------------------------------------------------------------| | | *Notifications view* | @@ -259,6 +265,16 @@ work without first loading =mastodon.el=: - =mastodon-tl--add-toot-account-at-point-to-list=: Add the account of the toot at point to a list. +- =mastodon-tl--dm-user=: Send a direct message to one of the users at point. + + +- =mastodon-profile--add-private-note-to-account=: Add a private note to another user’s account. +- =mastodon-profile--view-account-private-note=: View a private note on a user’s account. + + +- =mastodon-profile--show-familiar-followers=: Show a list of “familiar followers” for a given account. Familiar followers are accounts that you follow, and that follow the account. + + - =mastodon-tl--follow-tag=: Follow a tag (works like following a user) - =mastodon-tl--unfollow-tag=: Unfollow a tag - =mastodon-tl--list-followed-tags=: View a list of tags you're following. @@ -296,6 +312,7 @@ See =M-x customize-group RET mastodon= to view all customize options. - Avatar image height - Enable image caching - Hide replies in timelines + - Show toot stats in byline - Compose options: - Completion style for mentions and tags @@ -345,6 +362,9 @@ to your translator function as its text argument. Here's what (message "No toot to translate?")))) #+end_src +*** bookmarks and =mastodon.el= +=mastodon.el= doesn’t currently implement its own bookmark record and handler, which means that emacs bookmarks will not work as is. Until we implement them, you can get bookmarks going immediately by using [[https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el][bookmark+.el]]. + ** Dependencies Hard dependencies (should all install with =mastodon.el=): @@ -0,0 +1,18 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + + This (the Directory node) gives a menu of major topics. + Typing "q" exits, "H" lists all Info commands, "d" returns here, + "h" gives a primer for first-timers, + "mEmacs<Return>" visits the Emacs manual, etc. + + In Emacs, you can click mouse button 2 on a menu item or cross reference + to select it. + +* Menu: + +Emacs +* Mastodon: (mastodon). Client for Mastodon on ActivityPub networks. diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index a352ffc..9de69db 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -1,4 +1,4 @@ -;;; mastodon-async.el --- Client for Mastodon -*- lexical-binding: t -*- +;;; mastodon-async.el --- Async streaming functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017 Alex J. Griffith ;; Author: Alex J. Griffith <griffitaj@gmail.com> @@ -30,6 +30,7 @@ ;;; Code: +(require 'mastodon-tl) (require 'json) (require 'url-http) @@ -227,9 +228,9 @@ ENDPOINT is the endpoint for the stream and timeline." (mastodon-mode) (mastodon-tl--set-buffer-spec buffer-name endpoint - ,(if (equal name "notifications") - 'mastodon-notifications--timeline - 'mastodon-tl--timeline)) + (if (equal name "notifications") + 'mastodon-notifications--timeline + 'mastodon-tl--timeline)) (setq-local mastodon-tl--enable-relative-timestamps nil) (setq-local mastodon-tl--display-media-p t) (current-buffer)))) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 788fa77..ec56a05 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -37,14 +37,15 @@ (eval-when-compile (require 'subr-x)) ; for if-let (autoload 'mastodon-client "mastodon-client") +(autoload 'mastodon-client--active-user "mastodon-client") +(autoload 'mastodon-client--form-user-from-vars "mastodon-client") +(autoload 'mastodon-client--make-user-active "mastodon-client") +(autoload 'mastodon-client--store-access-token "mastodon-client") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--append-query-string "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--append-query-string "mastodon-http") -(autoload 'mastodon-client--store-access-token "mastodon-client") -(autoload 'mastodon-client--active-user "mastodon-client") -(autoload 'mastodon-client--make-user-active "mastodon-client") -(autoload 'mastodon-client--form-user-from-vars "mastodon-client") + (defvar mastodon-instance-url) (defvar mastodon-client-scopes) (defvar mastodon-client-redirect-uri) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index f1dcd4f..5981a26 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -37,10 +37,10 @@ (defvar mastodon-instance-url) (defvar mastodon-active-user) + (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") - (defcustom mastodon-client--token-file (concat user-emacs-directory "mastodon.plstore") "File path where Mastodon access tokens are stored." :group 'mastodon diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 57c1aa0..958df92 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -45,75 +45,79 @@ :bind "?" :mode 'mastodon-mode :mode-hook 'mastodon-mode-hook - :context-menu '(mastodon - (description "Mastodon feed viewer") - (actions - ("Toots" - ("A" "View profile of author" mastodon-profile--get-toot-author) - ("b" "Boost" mastodon-toot--boost) - ("f" "Favourite" mastodon-toot--favourite) - ("c" "Toggle hidden text (CW)" mastodon-tl--toggle-spoiler-text-in-toot) - ("k" "Bookmark toot" mastodon-toot--bookmark-toot-toggle) - ("v" "Vote on poll" mastodon-tl--poll-vote) - ("n" "Next" mastodon-tl--goto-next-toot) - ("p" "Prev" mastodon-tl--goto-prev-toot) - ("TAB" "Next link item" mastodon-tl--next-tab-item) - ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) - ;; NB: (when (require 'mpv etc. calls don't work here - ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point) - ("t" "New toot" mastodon-toot) - ("r" "Reply" mastodon-toot--reply) - ("C" "Copy toot URL" mastodon-toot--copy-toot-url) - ("d" "Delete (your) toot" mastodon-toot--delete-toot) - ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) - ("e" "Edit (your) toot" mastodon-toot--edit-toot-at-point) - ("E" "View edits of (your) toot" mastodon-toot--view-toot-edits) - ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) - ("P" "View user profile" mastodon-profile--show-user) - ("a" "Translate toot at point" mastodon-toot--translate-toot-text) - ("T" "View thread" mastodon-tl--thread) - ("v" "Vote on poll" mastodon-tl--poll-vote) - ("," "View toot's favouriters" mastodon-toot--list-toot-favouriters) - ("." "View toot's boosters" mastodon-toot--list-toot-boosters)) - ("Views" - ("h/?" "View mode help/keybindings" describe-mode) - ("#" "Tag search" mastodon-tl--get-tag-timeline) - ("F" "Federated" mastodon-tl--get-federated-timeline) - ("H" "Home" mastodon-tl--get-home-timeline) - ("L" "Local" mastodon-tl--get-local-timeline) - ("N" "Notifications" mastodon-notifications-get) - ("@" "Notifications with mentions" mastodon-notifications--get-mentions) - ("u" "Update timeline" mastodon-tl--update) - ("S" "Search" mastodon-search--search-query) - ("O" "Jump to your profile" mastodon-profile--my-profile) - ("U" "Update your profile note" mastodon-profile--update-user-profile-note) - ("K" "View bookmarks" mastodon-profile--view-bookmarks) - ("V" "View favourites" mastodon-profile--view-favourites) - ("R" "View follow requests" mastodon-profile--view-follow-requests) - ("G" "View follow suggestions" mastodon-tl--get-follow-suggestions) - ("I" "View filters" mastodon-tl--view-filters) - ("X" "View lists" mastodon-tl--view-lists) - ("s" "View scheduled toots" mastodon-tl--view-scheduled-toots) - (";" "View instance description" mastodon-tl--view-instance-description)) - ("Users" - ("W" "Follow" mastodon-tl--follow-user) - ("C-S-W" "Unfollow" mastodon-tl--unfollow-user) - ("M" "Mute" mastodon-tl--mute-user) - ("C-S-M" "Unmute" mastodon-tl--unmute-user) - ("B" "Block" mastodon-tl--block-user) - ("C-S-B" "Unblock" mastodon-tl--unblock-user)) - ("Images" - ;; RET errors here also :/ - ("<return>/i" "Load full image in browser" 'shr-browse-image) - ("r" "rotate" 'image-rotate) - ("+" "zoom in" 'image-increase-size) - ("-" "zoom out" 'image-decrease-size) - ("u" "copy URL" 'shr-maybe-probe-and-copy-url)) - ("Profile view" - ("C-c C-c" "Cycle profile views" mastodon-profile--account-view-cycle)) - ("Quit" - ("q" "Quit mastodon and bury buffer." kill-this-buffer) - ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window))))))) + :context-menu + '(mastodon + (description "Mastodon feed viewer") + (actions + ("Toots" + ("A" "View profile of author" mastodon-profile--get-toot-author) + ("b" "Boost" mastodon-toot--boost) + ("f" "Favourite" mastodon-toot--favourite) + ("c" "Toggle hidden text (CW)" mastodon-tl--toggle-spoiler-text-in-toot) + ("k" "Bookmark toot" mastodon-toot--toggle-bookmark) + ("v" "Vote on poll" mastodon-tl--poll-vote) + ("n" "Next" mastodon-tl--goto-next-toot) + ("p" "Prev" mastodon-tl--goto-prev-toot) + ("TAB" "Next link item" mastodon-tl--next-tab-item) + ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) + ;; NB: (when (require 'mpv etc. calls don't work here + ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point) + ("t" "New toot" mastodon-toot) + ("r" "Reply" mastodon-toot--reply) + ("C" "Copy toot URL" mastodon-toot--copy-toot-url) + ("d" "Delete (your) toot" mastodon-toot--delete-toot) + ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) + ("e" "Edit (your) toot" mastodon-toot--edit-toot-at-point) + ("E" "View edits of (your) toot" mastodon-toot--view-toot-edits) + ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) + ("P" "View user profile" mastodon-profile--show-user) + ("a" "Translate toot at point" mastodon-toot--translate-toot-text) + ("T" "View thread" mastodon-tl--thread) + ("v" "Vote on poll" mastodon-tl--poll-vote) + ("," "View toot's favouriters" mastodon-toot--list-toot-favouriters) + ("." "View toot's boosters" mastodon-toot--list-toot-boosters) + ("/" "Switch buffers" mastodon-switch-to-buffer)) + ("Views" + ("h/?" "View mode help/keybindings" describe-mode) + ("#" "Tag search" mastodon-tl--get-tag-timeline) + (";" "List followed tags" mastodon-tl--list-followed-tags) + ("F" "Federated" mastodon-tl--get-federated-timeline) + ("H" "Home" mastodon-tl--get-home-timeline) + ("L" "Local" mastodon-tl--get-local-timeline) + ("N" "Notifications" mastodon-notifications-get) + ("@" "Notifications with mentions" mastodon-notifications--get-mentions) + ("g/u" "Update timeline" mastodon-tl--update) + ("s" "Search" mastodon-search--search-query) + ("O" "Jump to your profile" mastodon-profile--my-profile) + ("U" "Update your profile note" mastodon-profile--update-user-profile-note) + ("K" "View bookmarks" mastodon-profile--view-bookmarks) + ("V" "View favourites" mastodon-profile--view-favourites) + ("R" "View follow requests" mastodon-profile--view-follow-requests) + ("G" "View follow suggestions" mastodon-tl--get-follow-suggestions) + ("I" "View filters" mastodon-tl--view-filters) + ("X" "View lists" mastodon-tl--view-lists) + ("S" "View scheduled toots" mastodon-tl--view-scheduled-toots) + (";" "View instance description" mastodon-tl--view-instance-description)) + ("Users" + ("W" "Follow" mastodon-tl--follow-user) + ("C-S-W" "Unfollow" mastodon-tl--unfollow-user) + ("M" "Mute" mastodon-tl--mute-user) + ("C-S-M" "Unmute" mastodon-tl--unmute-user) + ("B" "Block" mastodon-tl--block-user) + ("C-S-B" "Unblock" mastodon-tl--unblock-user)) + ("Images" + ;; RET errors here also :/ + ("<return>/i" "Load full image in browser" 'shr-browse-image) + ("r" "rotate" 'image-rotate) + ("+" "zoom in" 'image-increase-size) + ("-" "zoom out" 'image-decrease-size) + ("u" "copy URL" 'shr-maybe-probe-and-copy-url)) + ("Profile view" + ("C-c C-c" "Cycle profile views" mastodon-profile--account-view-cycle)) + ("Quit" + ("q" "Quit mastodon and bury buffer." kill-this-buffer) + ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window) + ("M-C-q" "Quit mastodon and kill all buffers." mastodon-kill-all-buffers))))))) - (provide 'mastodon-discover) +(provide 'mastodon-discover) ;;; mastodon-discover.el ends here diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 88bc9c6..3632a11 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -43,7 +43,6 @@ (autoload 'mastodon-auth--access-token "mastodon-auth") (autoload 'mastodon-toot--update-status-fields "mastodon-toot") - (defvar mastodon-http--api-version "v1") (defconst mastodon-http--timeout 15 @@ -318,7 +317,7 @@ PARAMS is an alist of any extra parameters to send with the request." (when status ;; only when we actually get sth? (apply callback (mastodon-http--process-json) cbargs))))) -(defun mastodon-http--post-async (url params headers &optional callback &rest cbargs) +(defun mastodon-http--post-async (url params _headers &optional callback &rest cbargs) "POST asynchronously to URL with PARAMS and HEADERS. Then run function CALLBACK with arguements CBARGS. Authorization header is included by default unless UNAUTHENTICED-P is non-nil." diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 3fb10b0..63860bd 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -50,17 +50,14 @@ (defcustom mastodon-media--avatar-height 20 "Height of the user avatar images (if shown)." - :group 'mastodon-media :type 'integer) (defcustom mastodon-media--preview-max-height 250 "Max height of any media attachment preview to be shown in timelines." - :group 'mastodon-media :type 'integer) (defcustom mastodon-media--enable-image-caching nil "Whether images should be cached." - :group 'mastodon-media :type 'boolean) (defvar mastodon-media--generic-avatar-data @@ -139,7 +136,7 @@ CAQgEIBAAAIBFiNOFMaY6V1tnFhkDQIQCEAgAIEABAKAQAACAQgEIBCAQAACAQgEIBCAQABIXO4e c1y+zhoEIBCAQAAQCEAgAIEABAIQCEAgAIEABAIQCEAgAAgEIBCAQAACAQgEIBCAQAACAQgEAIEA BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") - "The PNG data for a generic 200x200 'broken image' view.") + "The PNG data for a generic 200x200 \"broken image\" view.") (defun mastodon-media--process-image-response (status-plist marker image-options region-length url) @@ -185,7 +182,7 @@ with the image." (defun mastodon-media--load-image-from-url (url media-type start region-length) "Take a URL and MEDIA-TYPE and load the image asynchronously. -MEDIA-TYPE is a symbol and either 'avatar or 'media-link. +MEDIA-TYPE is a symbol and either `avatar' or `media-link.' START is the position where we start loading the image. REGION-LENGTH is the range from start to propertize." (let ((image-options (when (or (image-type-available-p 'imagemagick) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 279361b..22228f2 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -32,28 +32,28 @@ ;;; Code: -(autoload 'mastodon-http--api "mastodon-http.el") -(autoload 'mastodon-http--post "mastodon-http.el") -(autoload 'mastodon-http--triage "mastodon-http.el") -(autoload 'mastodon-media--inline-images "mastodon-media.el") -(autoload 'mastodon-tl--byline "mastodon-tl.el") -(autoload 'mastodon-tl--byline-author "mastodon-tl.el") -(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl.el") -(autoload 'mastodon-tl--content "mastodon-tl.el") -(autoload 'mastodon-tl--field "mastodon-tl.el") -(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") -(autoload 'mastodon-tl--has-spoiler "mastodon-tl.el") -(autoload 'mastodon-tl--init "mastodon-tl.el") -(autoload 'mastodon-tl--init-sync "mastodon-tl.el") -(autoload 'mastodon-tl--insert-status "mastodon-tl.el") -(autoload 'mastodon-tl--property "mastodon-tl.el") -(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") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-params-async-json "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-tl--byline "mastodon-tl") +(autoload 'mastodon-tl--byline-author "mastodon-tl") +(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") +(autoload 'mastodon-tl--content "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-tl--has-spoiler "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl") +(autoload 'mastodon-tl--insert-status "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-tl--spoiler "mastodon-tl") +(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-views--view-follow-requests "mastodon-views") + (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) (defvar mastodon-mode-map) @@ -126,7 +126,7 @@ follow-requests view." (mastodon-http--triage response (lambda () (if f-reqs-view-p - (mastodon-profile--view-follow-requests) + (mastodon-views--view-follow-requests) (mastodon-notifications-get)) (message "Follow request of %s (@%s) %s!" name handle (if reject diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 2607b82..74f9b62 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -38,55 +38,47 @@ (require 'seq) (require 'cl-lib) (require 'persist) -(require 'ts) (require 'parse-time) +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") (autoload 'mastodon-http--api "mastodon-http.el") (autoload 'mastodon-http--get-json "mastodon-http.el") +(autoload 'mastodon-http--get-json-async "mastodon-http.el") +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-http--patch "mastodon-http") +(autoload 'mastodon-http--patch-json "mastodon-http") (autoload 'mastodon-http--post "mastodon-http.el") (autoload 'mastodon-http--triage "mastodon-http.el") -(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") -(autoload 'mastodon-http--get-json-async "mastodon-http.el") (autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el") (autoload 'mastodon-media--inline-images "mastodon-media.el") (autoload 'mastodon-mode "mastodon.el") +(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-tl--as-string "mastodon-tl.el") +(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") (autoload 'mastodon-tl--byline-author "mastodon-tl.el") -(autoload 'mastodon-tl--goto-next-toot "mastodon-tl.el") -(autoload 'mastodon-tl--property "mastodon-tl.el") (autoload 'mastodon-tl--find-property-range "mastodon-tl.el") +(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl.el") +(autoload 'mastodon-tl--interactive-user-handles-get "mastodon-tl") +(autoload 'mastodon-tl--map-alist "mastodon-tl") +(autoload 'mastodon-tl--map-alist-vals-to-alist "mastodon-tl") +(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") +(autoload 'mastodon-tl--property "mastodon-tl.el") (autoload 'mastodon-tl--render-text "mastodon-tl.el") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--set-face "mastodon-tl.el") +(autoload 'mastodon-tl--symbol "mastodon-tl") (autoload 'mastodon-tl--timeline "mastodon-tl.el") -(autoload 'mastodon-tl--as-string "mastodon-tl.el") -(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--toot "mastodon-tl") -(autoload 'mastodon-tl--init "mastodon-tl.el") -(autoload 'mastodon-tl--init-sync "mastodon-tl") -(autoload 'mastodon-http--patch "mastodon-http") -(autoload 'mastodon-http--patch-json "mastodon-http") -(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") -(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") -(autoload 'mastodon-tl--goto-next-item "mastodon-tl") -(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") -(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") -(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") -(autoload 'mastodon-tl--add-account-to-list "mastodon-tl") -(autoload 'mastodon-http--get-response "mastodon-http") -(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") -(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") -(autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") -(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") +(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-toot--count-toot-chars "mastodon-toot") +(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") +(autoload 'mastodon-views--add-account-to-list "mastodon-views") -(defvar mastodon-instance-url) -(defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) -(defvar mastodon-mode-map) (defvar mastodon-toot--max-toot-chars) (defvar mastodon-toot--visibility) (defvar mastodon-toot--content-nsfw) @@ -106,23 +98,6 @@ map) "Keymap for `mastodon-profile-mode'.") -(defvar mastodon-profile--view-follow-requests-keymap - (let ((map ;(make-sparse-keymap))) - (copy-keymap mastodon-mode-map))) - ;; make reject binding match the binding in notifs view - ;; 'r' is then reserved for replying, even tho it is not avail - ;; in foll-reqs view - (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) - (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) - (define-key map (kbd "n") #'mastodon-tl--goto-next-item) - (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) - (define-key map (kbd "g") #'mastodon-profile--view-follow-requests) - ;; (define-key map (kbd "t") #'mastodon-toot) - ;; (define-key map (kbd "q") #'kill-current-buffer) - ;; (define-key map (kbd "Q") #'kill-buffer-and-window) - map) - "Keymap for viewing follow requests.") - (define-minor-mode mastodon-profile-mode "Toggle mastodon profile minor mode. This minor mode is used for mastodon profile pages and adds a couple of @@ -157,11 +132,6 @@ contains") (defun mastodon-profile--toot-json () "Get the next toot-json." (interactive) - ;; NB: we cannot add - ;; (or (mastodon-tl--property 'profile-json) - ;; here because it searches forward endlessly - ;; TODO: it would be nice to be able to do so tho - ;; or handle --property failing (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account &optional no-reblogs) @@ -172,15 +142,15 @@ NO-REBLOGS means do not display boosts in statuses." ;; TODO: we shd just load all views' data then switch coz this is slow af: (defun mastodon-profile--account-view-cycle () - "Cycle through profile view: toots, followers, and following." + "Cycle through profile view: toots, toot sans boosts, followers, and following." (interactive) (cond ((mastodon-tl--buffer-type-eq 'profile-statuses) + (mastodon-profile--open-statuses-no-reblogs)) + ((mastodon-tl--buffer-type-eq 'profile-statuses-no-boosts) (mastodon-profile--open-followers)) ((mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-profile--open-following)) ((mastodon-tl--buffer-type-eq 'profile-following) - (mastodon-profile--open-statuses-no-reblogs)) - (t (mastodon-profile--make-author-buffer mastodon-profile--account)))) (defun mastodon-profile--open-statuses-no-reblogs () @@ -232,35 +202,6 @@ NO-REBLOGS means do not display boosts in statuses." 'mastodon-tl--timeline :headers)) -(defun mastodon-profile--view-follow-requests () - "Open a new buffer displaying the user's follow requests." - (interactive) - (mastodon-tl--init-sync "follow-requests" - "follow_requests" - 'mastodon-profile--insert-follow-requests) - (use-local-map mastodon-profile--view-follow-requests-keymap) - (mastodon-tl--goto-first-item)) - -(defun mastodon-profile--insert-follow-requests (json) - "Insert the user's current follow requests. -JSON is the data returned by the server." - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " FOLLOW REQUESTS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[a/r - accept/reject request at point\n n/p - go to next/prev request]\n\n" - 'font-lock-comment-face)) - (if (seq-empty-p json) - (insert (propertize - "Looks like you have no follow requests for now." - 'face font-lock-comment-face - 'byline t - 'toot-id "0")) - (mastodon-search--insert-users-propertized json :note))) -;; (mastodon-profile--add-author-bylines json))) - (defun mastodon-profile--add-account-to-list () "Add account of current profile buffer to a list." (interactive) @@ -268,7 +209,7 @@ JSON is the data returned by the server." (let* ((profile mastodon-profile--account) (id (alist-get 'id profile)) (handle (alist-get 'acct profile))) - (mastodon-tl--add-account-to-list nil id handle)))) + (mastodon-views--add-account-to-list nil id handle)))) ;;; ACCOUNT PREFERENCES @@ -316,7 +257,7 @@ JSON is the data returned by the server." 'display nil) "/500 characters") 'read-only t - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'note-header t) "\n") (make-local-variable 'after-change-functions) @@ -375,7 +316,7 @@ Ask for confirmation if length > 500 characters." (defun mastodon-profile--update-preference (pref val &optional source) "Update account PREF erence to setting VAL. Both args are strings. -SOURCE means that the preference is in the 'source' part of the account JSON." +SOURCE means that the preference is in the `source' part of the account JSON." (let* ((url (mastodon-http--api "accounts/update_credentials")) (pref-formatted (if source (concat "source[" pref "]") pref)) (response (mastodon-http--patch url `((,pref-formatted . ,val))))) @@ -394,6 +335,7 @@ This is done after changing the setting on the server." (setq mastodon-profile-account-settings (plist-put mastodon-profile-account-settings pref val))) +;; used in toot.el (defun mastodon-profile--fetch-server-account-settings-maybe () "Fetch account settings from the server. Only do so if `mastodon-profile-account-settings' is nil." @@ -535,6 +477,7 @@ Returns the results as an alist." "Limit string X to 255 chars max." (if (> (length x) 255) (substring x 0 255) x)) +;; used in tl.el (defun mastodon-profile--get-preferences-pref (pref) "Fetch PREF from the endpoint \"/preferences\". This endpoint only holds a few preferences. For others, see @@ -584,10 +527,7 @@ FIELDS means provide a fields vector fetched by other means." (let ((fields (or fields (mastodon-profile--account-field account 'fields)))) (when fields - (mapcar (lambda (el) - (cons (alist-get 'name el) - (alist-get 'value el))) - fields)))) + (mastodon-tl--map-alist-vals-to-alist 'name 'value fields)))) (defun mastodon-profile--fields-insert (fields) "Format and insert field pairs (a.k.a profile metadata) in FIELDS." @@ -630,7 +570,11 @@ HEADERS means also fetch link headers for pagination." (endpoint (format "accounts/%s/%s" id endpoint-type)) (url (mastodon-http--api endpoint)) (acct (mastodon-profile--account-field account 'acct)) - (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) + (buffer (concat "*mastodon-" acct "-" + (if no-reblogs + (concat endpoint-type "-no-boosts") + endpoint-type) + "*")) (response (if headers (mastodon-http--get-response url args) (mastodon-http--get-json url args))) @@ -650,17 +594,21 @@ HEADERS means also fetch link headers for pagination." (mastodon-profile--account-field account 'statuses_count))) (relationships (mastodon-profile--relationships-get id)) + (requested-you (when (not (seq-empty-p relationships)) + (alist-get 'requested_by relationships))) (followed-by-you (when (not (seq-empty-p relationships)) (alist-get 'following relationships))) (follows-you (when (not (seq-empty-p relationships)) (alist-get 'followed_by relationships))) - (followsp (or (equal follows-you 't) (equal followed-by-you 't))) + (followsp (or (equal follows-you 't) (equal followed-by-you 't) + (equal requested-you 't))) (fields (mastodon-profile--fields-get account)) (pinned (mastodon-profile--get-statuses-pinned account)) (joined (mastodon-profile--account-field account 'created_at))) (with-current-buffer (get-buffer-create buffer) (let ((inhibit-read-only t)) (switch-to-buffer buffer) + (erase-buffer) (mastodon-mode) (mastodon-profile-mode) (setq mastodon-profile--account account) @@ -673,7 +621,9 @@ HEADERS means also fetch link headers for pagination." (is-followers (string= endpoint-type "followers")) (is-following (string= endpoint-type "following")) (endpoint-name (cond - (is-statuses " TOOTS ") + (is-statuses (if no-reblogs + " TOOTS (no boosts)" + " TOOTS ")) (is-followers " FOLLOWERS ") (is-following " FOLLOWING ")))) (insert @@ -721,10 +671,12 @@ HEADERS means also fetch link headers for pagination." ;; insert relationship (follows) (if followsp (mastodon-tl--set-face - (concat (if (equal follows-you 't) - " | FOLLOWS YOU") - (if (equal followed-by-you 't) - " | FOLLOWED BY YOU") + (concat (when (equal follows-you 't) + " | FOLLOWS YOU") + (when (equal followed-by-you 't) + " | FOLLOWED BY YOU") + (when (equal requested-you 't) + " | REQUESTED TO FOLLOW YOU") "\n\n") 'success) "") ; if no followsp we still need str-or-char-p for insert @@ -744,7 +696,9 @@ HEADERS means also fetch link headers for pagination." (goto-char (point-min))))) (defun mastodon-profile--format-joined-date-string (joined) - "Format a human-readable Joined string from timestamp JOINED." + "Format a human-readable Joined string from timestamp JOINED. +JOINED is the `created_at' field in profile account JSON, and of +the format \"2000-01-31T00:00:00.000Z\"." (format-time-string "Joined: %d %B %Y" (parse-iso8601-time-string joined))) @@ -755,10 +709,10 @@ If toot is a boost, opens the profile of the booster." (mastodon-profile--make-author-buffer (alist-get 'account (mastodon-profile--toot-json)))) -(defun mastodon-profile--image-from-account (account img_type) +(defun mastodon-profile--image-from-account (account img-type) "Return a avatar image from ACCOUNT. -IMG_TYPE is the JSON key from the account data." - (let ((img (alist-get img_type account))) +IMG-TYPE is the JSON key from the account data." + (let ((img (alist-get img-type account))) (unless (equal img "/avatars/original/missing.png") (mastodon-media--get-media-link-rendering img)))) @@ -767,7 +721,7 @@ IMG_TYPE is the JSON key from the account data." (interactive (list (if (and (not (mastodon-tl--profile-buffer-p)) - (not (get-text-property (point) 'toot-json))) + (not (mastodon-tl--property 'toot-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((user-handles (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))) @@ -778,7 +732,7 @@ IMG_TYPE is the JSON key from the account data." (if (not (or ;; own profile has no need for toot-json test: (equal user-handle (mastodon-auth--get-account-name)) - (get-text-property (point) 'toot-json))) + (mastodon-tl--property 'toot-json :no-move))) (message "Looks like there's no toot or user at point?") (let ((account (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json)))) @@ -797,7 +751,7 @@ IMG_TYPE is the JSON key from the account data." (defun mastodon-profile--account-field (account field) "Return FIELD from the ACCOUNT. -FIELD is used to identify regions under 'account" +FIELD is used to identify regions under `account'." (cdr (assoc field account))) (defun mastodon-profile--add-author-bylines (tootv) @@ -859,15 +813,13 @@ These include the author, author of reblogged entries and any user mentioned." (reblog (or (alist-get 'reblog (alist-get 'status status)) (alist-get 'reblog status)))) (seq-filter - 'stringp + #'stringp (seq-uniq (seq-concatenate 'list (list (alist-get 'acct this-account)) (mastodon-profile--extract-users-handles reblog) - (mapcar (lambda (mention) - (alist-get 'acct mention)) - mentions))))))) + (mastodon-tl--map-alist 'acct mentions))))))) (defun mastodon-profile--lookup-account-in-status (handle status) "Return account for HANDLE using hints in STATUS if possible." @@ -894,7 +846,7 @@ These include the author, author of reblogged entries and any user mentioned." "Remove a user from your followers. Optionally provide the ID of the account to remove." (interactive) - (let* ((account (unless id (get-text-property (point) 'toot-json))) + (let* ((account (unless id (mastodon-tl--property 'toot-json :no-move))) (id (or id (alist-get 'id account))) (handle (if account (alist-get 'acct account) @@ -931,15 +883,104 @@ Currently limited to 100 handles. If not found, try (url (mastodon-http--api endpoint)) (response (mastodon-http--get-json url `(("limit" . "100")))) - (handles (mapcar (lambda (x) - (cons - (alist-get 'acct x) - (alist-get 'id x))) - response)) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response)) (choice (completing-read "Remove from followers: " handles)) (id (alist-get choice handles nil nil 'equal))) (mastodon-profile--remove-user-from-followers id))) +(defun mastodon-profile--add-private-note-to-account () + "Add a private note to an account. +Can be called from a profile page or normal timeline. +Send an empty note to clear an existing one." + (interactive) + (mastodon-profile--add-or-view-private-note + 'mastodon-profile--post-private-note-to-account + "add a note to")) + +(defun mastodon-profile--post-private-note-to-account (id handle note-old) + "POST a private note onto an account ID with user HANDLE on the server. +NOTE-OLD is the text of any existing note." + (let* ((note (read-string (format "Add private note to account %s: " handle) + note-old)) + (params `(("comment" . ,note))) + (url (mastodon-http--api (format "accounts/%s/note" id))) + (response (mastodon-http--post url params))) + (mastodon-http--triage response + (lambda () + (message "Private note on %s added!" handle))))) + +(defun mastodon-profile--view-account-private-note () + "Display the private note about a user." + (interactive) + (mastodon-profile--add-or-view-private-note + 'mastodon-profile--display-private-note + "view private note of" + :view)) + +(defun mastodon-profile--display-private-note (note) + "Display private NOTE in a temporary buffer." + (with-output-to-temp-buffer "*mastodon-profile-private-note*" + (let ((inhibit-read-only t)) + (princ note)))) + +(defun mastodon-profile--profile-json () + "Return the profile-json property if we are in a profile buffer." + (when (mastodon-tl--profile-buffer-p) + (save-excursion + (goto-char (point-min)) + (or (mastodon-tl--property 'profile-json :no-move) + (error "No profile data found"))))) + +(defun mastodon-profile--add-or-view-private-note (action-fun &optional message view) + "Add or view a private note for an account. +ACTION-FUN does the adding or viewing, MESSAGE is a prompt for +`mastodon-tl--interactive-user-handles-get', VIEW is a flag." + (let* ((profile-json (mastodon-profile--profile-json)) + (handle (if (mastodon-tl--profile-buffer-p) + (alist-get 'acct profile-json) + (mastodon-tl--interactive-user-handles-get message))) + (account (if (mastodon-tl--profile-buffer-p) + profile-json + (mastodon-profile--search-account-by-handle handle))) + (id (alist-get 'id account)) + (relationships (mastodon-profile--relationships-get id)) + (note (alist-get 'note relationships))) + (if view + (if (string-empty-p note) + (message "No private note for %s" handle) + (funcall action-fun note)) + (funcall action-fun id handle note)))) + +(defun mastodon-profile--show-familiar-followers () + "Show a list of familiar followers. +Familiar followers are accounts that you follow, and that follow +the given account." + (interactive) + (let* ((profile-json (mastodon-profile--profile-json)) + (handle + (if (mastodon-tl--profile-buffer-p) + (alist-get 'acct profile-json) + (mastodon-tl--interactive-user-handles-get "show familiar followers of"))) + (account (if (mastodon-tl--profile-buffer-p) + profile-json + (mastodon-profile--search-account-by-handle handle))) + (id (alist-get 'id account))) + (mastodon-profile--get-familiar-followers id))) + +(defun mastodon-profile--get-familiar-followers (id) + "Return JSON data of familiar followers for account ID." + ;; the server can handle multiple IDs, but for now we just handle one. + (let* ((params `(("id" . ,id))) + (url (mastodon-http--api "accounts/familiar_followers")) + (json (mastodon-http--get-json url params)) + (accounts (alist-get 'accounts (car json))) ; first id result + (handles (mastodon-tl--map-alist 'acct accounts))) + (if (null handles) + (message "Looks like there are no familiar followers for this account") + (let ((choice (completing-read "Show profile of user: " + handles))) + (mastodon-profile--show-user choice))))) + (provide 'mastodon-profile) ;;; mastodon-profile.el ends here diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 0f2a6d4..b5900c7 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -31,22 +31,20 @@ ;;; Code: (require 'json) +(autoload 'mastodon-auth--access-token "mastodon-auth") +(autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-http--get-search-json "mastodon-http") (autoload 'mastodon-mode "mastodon") -(autoload 'mastodon-tl--set-face "mastodon-tl") -(autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-tl--as-string "mastodon-tl") -(autoload 'mastodon-auth--access-token "mastodon-auth") -(autoload 'mastodon-http--get-search-json "mastodon-http") -(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--set-face "mastodon-tl") (defvar mastodon-toot--completion-style-for-mentions) (defvar mastodon-instance-url) (defvar mastodon-tl--link-keymap) -(defvar mastodon-http--timeout) -(defvar mastodon-toot--enable-completion-for-mentions) ;; functions for completion of mentions in mastodon-toot @@ -123,7 +121,7 @@ QUERY is the string to search." tags)) ;; (status-list (mapcar #'mastodon-search--get-status-info ;; statuses)) - (status-ids-list (mapcar 'mastodon-search--get-id-from-status + (status-ids-list (mapcar #'mastodon-search--get-id-from-status statuses)) (toots-list-json (mapcar #'mastodon-search--fetch-full-status-from-id status-ids-list))) @@ -155,7 +153,7 @@ QUERY is the string to search." " STATUSES\n" " ------------\n") 'success)) - (mapc 'mastodon-tl--toot toots-list-json) + (mapc #'mastodon-tl--toot toots-list-json) (goto-char (point-min)))))) (defun mastodon-search--insert-users-propertized (json &optional note) @@ -186,7 +184,7 @@ user's profile note. This is also called by 'help-echo (concat "Browse user profile of @" (cadr user))) " : \n" (if note - (mastodon-tl--render-text (cadddr user) nil) + (mastodon-tl--render-text (cadddr user) acct) "") "\n") 'toot-json acct))) ; so named for compat w other processing functions diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9c12f84..644a3d4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1,4 +1,4 @@ -;;; mastodon-tl.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*- +;;; mastodon-tl.el --- Timeline functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen ;; Copyright (C) 2020-2022 Marty Hiatt @@ -38,53 +38,52 @@ (require 'time-date) (require 'cl-lib) (require 'mastodon-iso) - (require 'mpv nil :no-error) +(autoload 'mastodon-auth--get-account-id "mastodon-auth") (autoload 'mastodon-auth--get-account-name "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--build-params-string "mastodon-http") +(autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-http--get-response-async "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") (autoload 'mastodon-media--get-avatar-rendering "mastodon-media") (autoload 'mastodon-media--get-media-link-rendering "mastodon-media") (autoload 'mastodon-media--inline-images "mastodon-media") (autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-notifications-get "mastodon-notifications" + "Display NOTIFICATIONS in buffer." t) ; interactive +(autoload 'mastodon-profile--account-field "mastodon-profile") (autoload 'mastodon-profile--account-from-id "mastodon-profile") +(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") +(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-profile--get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--my-profile "mastodon-profile") +(autoload 'mastodon-profile--profile-json "mastodon-profile") (autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") -;; mousebot adds (autoload 'mastodon-profile--toot-json "mastodon-profile") -(autoload 'mastodon-profile--account-field "mastodon-profile") -(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") -(autoload 'mastodon-profile--my-profile "mastodon-profile") -(autoload 'mastodon-toot--delete-toot "mastodon-toot") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--triage "mastodon-http") -(autoload 'mastodon-http--get-json-async "mastodon-http") -(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") +(autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") -;; make notifications--get available via M-x and outside our keymap: -(autoload 'mastodon-notifications-get "mastodon-notifications" - "Display NOTIFICATIONS in buffer." t) ; interactive -(autoload 'mastodon-search--propertize-user "mastodon-search") -(autoload 'mastodon-search--insert-users-propertized "mastodon-search") (autoload 'mastodon-search--get-user-info "mastodon-search") -(autoload 'mastodon-http--delete "mastodon-http") -(autoload 'mastodon-profile--view-author-profile "mastodon-profile") -(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") -(autoload 'mastodon-http--get-response-async "mastodon-http") -(autoload 'mastodon-url-lookup "mastodon") -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-http--put "mastodon-http") -(autoload 'mastodon-http--process-json "mastodon-http") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--build-params-string "mastodon-http") -(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") -(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") -(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-search--propertize-user "mastodon-search") (autoload 'mastodon-toot--compose-buffer "mastodon-toot") -(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") -(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--delete-toot "mastodon-toot") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") (autoload 'mastodon-toot--iso-to-human "mastodon-toot") +(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") +(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-url-lookup "mastodon") (defvar mastodon-toot--visibility) (defvar mastodon-toot-mode) @@ -97,6 +96,9 @@ (defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this (defvar mastodon-mode-map) + +;;; CUSTOMIZES + (defgroup mastodon-tl nil "Timelines in Mastodon." :prefix "mastodon-tl-" @@ -106,13 +108,11 @@ "Whether to show relative (to the current time) timestamps. This will require periodic updates of a timeline buffer to keep the timestamps current as time progresses." - :group 'mastodon-tl :type '(boolean :tag "Enable relative timestamps and background updater task")) (defcustom mastodon-tl--enable-proportional-fonts nil "Nonnil to enable using proportional fonts when rendering HTML. By default fixed width fonts are used." - :group 'mastodon-tl :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) @@ -120,17 +120,16 @@ width fonts when rendering HTML text")) "Display an image's caption rather than URL. Only has an effect when `mastodon-tl--display-media-p' is set to nil." - :group 'mastodon-tl :type 'boolean) -(defvar-local mastodon-tl--buffer-spec nil - "A unique identifier and functions for each Mastodon buffer.") - (defcustom mastodon-tl--show-avatars nil "Whether to enable display of user avatars in timelines." - :group 'mastodon-tl :type '(boolean :tag "Whether to display user avatars in timelines")) +(defcustom mastodon-tl--show-stats t + "Whether to show toot stats (faves, boosts, replies counts)." + :type 'bool) + (defcustom mastodon-tl--symbols '((reply . ("💬" . "R")) (boost . ("🔁" . "B")) @@ -145,8 +144,7 @@ nil." "A set of symbols (and fallback strings) to be used in timeline. If a symbol does not look right (tofu), it means your font settings do not support it." - :type '(alist :key-type symbol :value-type string) - :group 'mastodon-tl) + :type '(alist :key-type symbol :value-type string)) (defcustom mastodon-tl-position-after-update nil "Defines where `point' should be located after a timeline update. @@ -167,9 +165,14 @@ Must be an integer between 20 and 40 inclusive." "Whether to hide replies from the timelines. Note that you can hide replies on a one-off basis by loading a timeline with a simple prefix argument, `C-u'." - :group 'mastodon-tl :type '(boolean :tag "Whether to hide replies from the timelines.")) + +;;; VARIABLES + +(defvar-local mastodon-tl--buffer-spec nil + "A unique identifier and functions for each Mastodon buffer.") + (defvar-local mastodon-tl--update-point nil "When updating a mastodon buffer this is where new toots will be inserted. If nil `(point-min)' is used instead.") @@ -186,129 +189,69 @@ If nil `(point-min)' is used instead.") (defvar-local mastodon-tl--timestamp-update-timer nil "The timer that, when set will scan the buffer to update the timestamps.") -;; KEYMAPS + +;;; KEYMAPS (defvar mastodon-tl--link-keymap (let ((map (make-sparse-keymap))) (define-key map [return] 'mastodon-tl--do-link-action-at-point) (define-key map [mouse-2] 'mastodon-tl--do-link-action) (define-key map [follow-link] 'mouse-face) - (keymap-canonicalize map)) + map) "The keymap for link-like things in buffer (except for shr.el generate links). This will make the region of text act like like a link with mouse highlighting, mouse click action tabbing to next/previous link etc.") (defvar mastodon-tl--shr-map-replacement - (let ((map (copy-keymap shr-map))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map shr-map) ;; Replace the move to next/previous link bindings with our ;; version that knows about more types of links. - (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item) - (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item) + (define-key map [remap shr-next-link] #'mastodon-tl--next-tab-item) + (define-key map [remap shr-previous-link] #'mastodon-tl--previous-tab-item) ;; keep new my-profile binding; shr 'O' doesn't work here anyway - (define-key map (kbd "O") 'mastodon-profile--my-profile) - (define-key map [remap shr-browse-url] 'mastodon-url-lookup) - (keymap-canonicalize map)) + (define-key map (kbd "O") #'mastodon-profile--my-profile) + (define-key map [remap shr-browse-url] #'mastodon-url-lookup) + map) "The keymap to be set for shr.el generated links that are not images. We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") (defvar mastodon-tl--shr-image-map-replacement - (let ((map (copy-keymap (if (boundp 'shr-image-map) - shr-image-map - shr-map)))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (if (boundp 'shr-image-map) + shr-image-map + shr-map)) ;; Replace the move to next/previous link bindings with our ;; version that knows about more types of links. - (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item) - (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item) + (define-key map [remap shr-next-link] #'mastodon-tl--next-tab-item) + (define-key map [remap shr-previous-link] #'mastodon-tl--previous-tab-item) ;; browse-url loads the preview only, we want browse-image ;; on RET to browse full sized image URL - (define-key map [remap shr-browse-url] 'shr-browse-image) + (define-key map [remap shr-browse-url] #'shr-browse-image) ;; remove shr's u binding, as it the maybe-probe-and-copy-url ;; is already bound to w also - (define-key map (kbd "u") 'mastodon-tl--update) + (define-key map (kbd "u") #'mastodon-tl--update) ;; keep new my-profile binding; shr 'O' doesn't work here anyway - (define-key map (kbd "O") 'mastodon-profile--my-profile) - (define-key map (kbd "<C-return>") 'mastodon-tl--mpv-play-video-at-point) - (keymap-canonicalize map)) + (define-key map (kbd "O") #'mastodon-profile--my-profile) + (define-key map (kbd "<C-return>") #'mastodon-tl--mpv-play-video-at-point) + map) "The keymap to be set for shr.el generated image links. We need to override the keymap so tabbing will navigate to all types of mastodon links and not just shr.el-generated ones.") -(defvar mastodon-tl--view-filters-keymap - (let ((map - (copy-keymap mastodon-mode-map))) - (define-key map (kbd "d") 'mastodon-tl--delete-filter) - (define-key map (kbd "c") 'mastodon-tl--create-filter) - (define-key map (kbd "n") 'mastodon-tl--goto-next-item) - (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) - (define-key map (kbd "TAB") 'mastodon-tl--goto-next-item) - (define-key map (kbd "g") 'mastodon-tl--view-filters) - (keymap-canonicalize map)) - "Keymap for viewing filters.") - -(defvar mastodon-tl--follow-suggestions-map - (let ((map - (copy-keymap mastodon-mode-map))) - (define-key map (kbd "n") 'mastodon-tl--goto-next-item) - (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) - (define-key map (kbd "g") 'mastodon-tl--get-follow-suggestions) - (keymap-canonicalize map)) - "Keymap for viewing follow suggestions.") - -(defvar mastodon-tl--view-lists-keymap - (let ((map ;(make-sparse-keymap))) - (copy-keymap mastodon-mode-map))) - (define-key map (kbd "D") 'mastodon-tl--delete-list) - (define-key map (kbd "C") 'mastodon-tl--create-list) - (define-key map (kbd "A") 'mastodon-tl--add-account-to-list) - (define-key map (kbd "R") 'mastodon-tl--remove-account-from-list) - (define-key map (kbd "E") 'mastodon-tl--edit-list) - (define-key map (kbd "n") 'mastodon-tl--goto-next-item) - (define-key map (kbd "p") 'mastodon-tl--goto-prev-item) - (define-key map (kbd "g") 'mastodon-tl--view-lists) - (keymap-canonicalize map)) - "Keymap for viewing lists.") - -(defvar mastodon-tl--list-name-keymap - (let ((map (make-sparse-keymap))) - (define-key map (kbd "<return>") 'mastodon-tl--view-timeline-list-at-point) - (define-key map (kbd "d") 'mastodon-tl--delete-list-at-point) - (define-key map (kbd "a") 'mastodon-tl--add-account-to-list-at-point) - (define-key map (kbd "r") 'mastodon-tl--remove-account-from-list-at-point) - (define-key map (kbd "e") 'mastodon-tl--edit-list-at-point) - (keymap-canonicalize map)) - "Keymap for when point is on list name.") - -(defvar mastodon-tl--scheduled-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "r") 'mastodon-tl--reschedule-toot) - (define-key map (kbd "c") 'mastodon-tl--cancel-scheduled-toot) - (define-key map (kbd "e") 'mastodon-tl--edit-scheduled-as-new) - (define-key map (kbd "<return>") 'mastodon-tl--edit-scheduled-as-new) - (keymap-canonicalize map)) - "Keymap for when point is on a scheduled toot.") - (defvar mastodon-tl--byline-link-keymap (when (require 'mpv nil :no-error) (let ((map (make-sparse-keymap))) - (define-key map (kbd "<C-return>") 'mastodon-tl--mpv-play-video-from-byline) - (define-key map (kbd "<return>") 'mastodon-profile--get-toot-author) - (keymap-canonicalize map))) + (define-key map (kbd "<C-return>") #'mastodon-tl--mpv-play-video-from-byline) + (define-key map (kbd "RET") #'mastodon-profile--get-toot-author) + map)) "The keymap to be set for the author byline. It is active where point is placed by `mastodon-tl--goto-next-toot.'") -(defun mastodon-tl--symbol (name) - "Return the unicode symbol (as a string) corresponding to NAME. -If symbol is not displayable, an ASCII equivalent is returned. If -NAME is not part of the symbol table, '?' is returned." - (if-let* ((symbol (alist-get name mastodon-tl--symbols))) - (if (char-displayable-p (string-to-char (car symbol))) - (car symbol) - (cdr symbol)) - "?")) - -;; NAV + +;;; NAV (defun mastodon-tl--next-tab-item () "Move to the next interesting item. @@ -320,7 +263,6 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (search-pos (point))) (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop search-pos nil)) - (get-text-property (car next-range) 'invisible) (setq search-pos (1+ (cdr next-range)))) ;; do nothing, all the action in in the while condition @@ -328,7 +270,7 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (if (null next-range) (message "Nothing else here.") (goto-char (car next-range)) - (message "%s" (get-text-property (point) 'help-echo))))) + (message "%s" (mastodon-tl--property 'help-echo :no-move))))) (defun mastodon-tl--previous-tab-item () "Move to the previous interesting item. @@ -348,13 +290,11 @@ text, i.e. hidden spoiler text." (if (null next-range) (message "Nothing else before this.") (goto-char (car next-range)) - (message "%s" (get-text-property (point) 'help-echo))))) - + (message "%s" (mastodon-tl--property 'help-echo :no-move))))) (defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) "Search for toot with FIND-POS. If search returns nil, execute REFRESH function. - Optionally start from POS." (let* ((npos (funcall find-pos (or pos (point)) @@ -401,7 +341,8 @@ Used on initializing a timeline or thread." (mastodon-tl--goto-toot-pos 'previous-single-property-change 'previous-line)) -;; TIMELINES + +;;; TIMELINES (defun mastodon-tl--get-federated-timeline () "Opens federated timeline." @@ -448,23 +389,20 @@ Optionally load TAG timeline directly." 'mastodon-tl--timeline nil `(("limit" . ,mastodon-tl--timeline-posts-count)))) + +;;; BYLINES, etc. + (defun mastodon-tl--message-help-echo () - "Call message on 'help-echo property at point. + "Call message on `help-echo' property at point. Do so if type of status at poins is not follow_request/follow." (let ((type (alist-get 'type - (get-text-property (point) 'toot-json))) - (echo (get-text-property (point) 'help-echo))) + (mastodon-tl--property 'toot-json :no-move))) + (echo (mastodon-tl--property 'help-echo :no-move))) (when echo ; not for followers/following in profile (unless (or (string= type "follow_request") (string= type "follow")) ; no counts for these - (message "%s" (get-text-property (point) 'help-echo)))))) - -(defun mastodon-tl--remove-html (toot) - "Remove unrendered tags from TOOT." - (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) - (t2 (replace-regexp-in-string "<\/?span>" "" t1))) - (replace-regexp-in-string "<span class=\"h-card\">" "" t2))) + (message "%s" (mastodon-tl--property 'help-echo :no-move)))))) (defun mastodon-tl--byline-author (toot &optional avatar) "Propertize author of TOOT. @@ -476,8 +414,6 @@ With arg AVATAR, include the account's avatar image." (alist-get 'username account))) (profile-url (alist-get 'url account)) (avatar-url (alist-get 'avatar account))) - ;; TODO: Once we have a view for a user (e.g. their posts - ;; timeline) make this a tab-stop and attach an action (concat ;; avatar insertion moved up to `mastodon-tl--byline' by default in order ;; to be outside of text prop 'byline t. arg avatar is used by @@ -501,34 +437,34 @@ With arg AVATAR, include the account's avatar image." ;; we don't have a tl--buffer-spec yet: (unless (or (string-suffix-p "-followers*" (buffer-name)) (string-suffix-p "-following*" (buffer-name))) - ;; (mastodon-tl--get-endpoint))) - (mastodon-tl--format-faves-count toot))) + (mastodon-tl--format-byline-help-echo toot))) " (" (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) -(defun mastodon-tl--format-faves-count (toot) - "Format a favourites, boosts, replies count for a TOOT. -Used as a help-echo when point is at the start of a byline, i.e. -where `mastodon-tl--goto-next-toot' leaves point. Also displays a -toot's media types and optionally the binding to play moving -image media from the byline." +(defun mastodon-tl--format-byline-help-echo (toot) + "Format a help-echo for byline of TOOT. +Displays a toot's media types and optionally the binding to play +moving image media from the byline. +Used when point is at the start of a byline, i.e. where +`mastodon-tl--goto-next-toot' leaves point." (let* ((toot-to-count (or ;; simply praying this order works (alist-get 'status toot) ; notifications timeline ;; fol-req notif, has 'type ;; placed before boosts coz fol-reqs have a (useless) reblog entry: - ;; TODO: cd also test for notifs buffer before we do this to be sure - (when (alist-get 'type toot) + (when (and (or (mastodon-tl--buffer-type-eq 'notifications) + (mastodon-tl--buffer-type-eq 'mentions)) + (alist-get 'type toot)) toot) (alist-get 'reblog toot) ; boosts toot)) ; everything else @@ -536,26 +472,20 @@ image media from the byline." (string= (alist-get 'type toot-to-count) "follow_request")))) (unless fol-req-p (let* ((media-types (mastodon-tl--get-media-types toot)) - (format-faves (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot-to-count) - (alist-get 'reblogs_count toot-to-count) - (alist-get 'replies_count toot-to-count))) (format-media (when media-types - (format " | media: %s" + (format "media: %s" (mapconcat #'identity media-types " ")))) (format-media-binding (when (and (or (member "video" media-types) (member "gifv" media-types)) (require 'mpv nil :no-error)) (format " | C-RET to view with mpv")))) - (format "%s" (concat format-faves format-media format-media-binding)))))) + (format "%s" (concat format-media format-media-binding)))))) (defun mastodon-tl--get-media-types (toot) "Return a list of the media attachment types of the TOOT at point." (let* ((attachments (mastodon-tl--field 'media_attachments toot))) - (mapcar (lambda (x) - (alist-get 'type x)) - attachments))) + (mastodon-tl--map-alist 'type attachments))) (defun mastodon-tl--get-attachments-for-byline (toot) "Return a list of attachment URLs and types for TOOT. @@ -581,74 +511,20 @@ The result is added as an attachments property to author-byline." " " (mastodon-tl--byline-author reblog))))) -(defun mastodon-tl--field (field toot) - "Return FIELD from TOOT. -Return value from boosted content if available." - (or (alist-get field (alist-get 'reblog toot)) - (alist-get field toot))) - -(defun mastodon-tl--relative-time-details (timestamp &optional current-time) - "Return cons of (descriptive string . next change) for the TIMESTAMP. -Use the optional CURRENT-TIME as the current time (only used for -reliable testing). - -The descriptive string is a human readable version relative to -the current time while the next change timestamp give the first -time that this description will change in the future. - -TIMESTAMP is assumed to be in the past." - (let* ((now (or current-time (current-time))) - (time-difference (time-subtract now timestamp)) - (seconds-difference (float-time time-difference)) - (regular-response - (lambda (seconds-difference multiplier unit-name) - (let ((n (floor (+ 0.5 (/ seconds-difference multiplier))))) - (cons (format "%d %ss ago" n unit-name) - (* (+ 0.5 n) multiplier))))) - (relative-result - (cond - ((< seconds-difference 60) - (cons "just now" - 60)) - ((< seconds-difference (* 1.5 60)) - (cons "1 minute ago" - 90)) ;; at 90 secs - ((< seconds-difference (* 60 59.5)) - (funcall regular-response seconds-difference 60 "minute")) - ((< seconds-difference (* 1.5 60 60)) - (cons "1 hour ago" - (* 60 90))) ;; at 90 minutes - ((< seconds-difference (* 60 60 23.5)) - (funcall regular-response seconds-difference (* 60 60) "hour")) - ((< seconds-difference (* 1.5 60 60 24)) - (cons "1 day ago" - (* 1.5 60 60 24))) ;; at a day and a half - ((< seconds-difference (* 60 60 24 6.5)) - (funcall regular-response seconds-difference (* 60 60 24) "day")) - ((< seconds-difference (* 1.5 60 60 24 7)) - (cons "1 week ago" - (* 1.5 60 60 24 7))) ;; a week and a half - ((< seconds-difference (* 60 60 24 7 52)) - (if (= 52 (floor (+ 0.5 (/ seconds-difference 60 60 24 7)))) - (cons "52 weeks ago" - (* 60 60 24 7 52)) - (funcall regular-response seconds-difference (* 60 60 24 7) "week"))) - ((< seconds-difference (* 1.5 60 60 24 365)) - (cons "1 year ago" - (* 60 60 24 365 1.5))) ;; a year and a half - (t - (funcall regular-response seconds-difference (* 60 60 24 365.25) "year"))))) - (cons (car relative-result) - (time-add timestamp (seconds-to-time (cdr relative-result)))))) - -(defun mastodon-tl--relative-time-description (timestamp &optional current-time) - "Return a string with a human readable TIMESTAMP relative to the current time. -Use the optional CURRENT-TIME as the current time (only used for -reliable testing). - -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--format-faved-or-boosted-byline (letter) + "Format the byline marker for a boosted or favourited status. +LETTER is a string, F for favourited, B for boosted, or K for bookmarked." + (let ((help-string (cond ((equal letter "F") + "favourited") + ((equal letter "B") + "boosted") + ((equal letter (or "🔖" "K")) + "bookmarked")))) + (format "(%s) " + (propertize letter 'face 'mastodon-boost-fave-face + ;; emojify breaks this for 🔖: + 'help-echo (format "You have %s this status." + help-string))))) (defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p) "Generate byline for TOOT. @@ -657,7 +533,6 @@ 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'. - DETAILED-P means display more detailed info. For now this just means displaying toot client." (let* ((created-time @@ -715,8 +590,6 @@ this just means displaying toot client." (concat " " (mastodon-tl--symbol 'private)))) (funcall action-byline toot) " " - ;; TODO: Once we have a view for toot (responses etc.) make - ;; this a tab stop and attach an action. (propertize (format-time-string mastodon-toot-timestamp-format parsed-time) 'timestamp parsed-time @@ -746,13 +619,17 @@ this just means displaying toot client." (propertize (format-time-string mastodon-toot-timestamp-format edited-parsed) - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'timestamp edited-parsed 'display (if mastodon-tl--enable-relative-timestamps (mastodon-tl--relative-time-description edited-parsed) edited-parsed))) "") - (propertize "\n ------------\n" 'face 'default)) + (propertize "\n ------------" 'face 'default) + (if mastodon-tl--show-stats + (mastodon-tl--toot-stats toot) + "") + "\n") 'favourited-p faved 'boosted-p boosted 'bookmarked-p bookmarked @@ -761,36 +638,71 @@ this just means displaying toot client." (mastodon-toot--get-toot-edits (alist-get 'id toot))) 'byline t)))) -(defun mastodon-tl--format-edit-timestamp (timestamp) - "Convert edit TIMESTAMP into a descriptive string." - (let ((parsed (ts-human-duration - (ts-diff (ts-now) (ts-parse timestamp))))) - (cond ((> (plist-get parsed :days) 0) - (format "%s days ago" (plist-get parsed :days) (plist-get parsed :hours))) - ((> (plist-get parsed :hours) 0) - (format "%s hours ago" (plist-get parsed :hours) (plist-get parsed :minutes))) - ((> (plist-get parsed :minutes) 0) - (format "%s minutes ago" (plist-get parsed :minutes))) - (t ;; we failed to guess: - (format "%s days, %s hours, %s minutes ago" - (plist-get parsed :days) - (plist-get parsed :hours) - (plist-get parsed :minutes)))))) + +;;; TIMESTAMPS -(defun mastodon-tl--format-faved-or-boosted-byline (letter) - "Format the byline marker for a boosted or favourited status. -LETTER is a string, F for favourited, B for boosted, or K for bookmarked." - (let ((help-string (cond ((equal letter "F") - "favourited") - ((equal letter "B") - "boosted") - ((equal letter (or "🔖" "K")) - "bookmarked")))) - (format "(%s) " - (propertize letter 'face 'mastodon-boost-fave-face - ;; emojify breaks this for 🔖: - 'help-echo (format "You have %s this status." - help-string))))) +(defun mastodon-tl--relative-time-details (timestamp &optional current-time) + "Return cons of (descriptive string . next change) for the TIMESTAMP. +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). +The descriptive string is a human readable version relative to +the current time while the next change timestamp give the first +time that this description will change in the future. +TIMESTAMP is assumed to be in the past." + (let* ((now (or current-time (current-time))) + (time-difference (time-subtract now timestamp)) + (seconds-difference (float-time time-difference)) + (regular-response + (lambda (seconds-difference multiplier unit-name) + (let ((n (floor (+ 0.5 (/ seconds-difference multiplier))))) + (cons (format "%d %ss ago" n unit-name) + (* (+ 0.5 n) multiplier))))) + (relative-result + (cond + ((< seconds-difference 60) + (cons "just now" + 60)) + ((< seconds-difference (* 1.5 60)) + (cons "1 minute ago" + 90)) ;; at 90 secs + ((< seconds-difference (* 60 59.5)) + (funcall regular-response seconds-difference 60 "minute")) + ((< seconds-difference (* 1.5 60 60)) + (cons "1 hour ago" + (* 60 90))) ;; at 90 minutes + ((< seconds-difference (* 60 60 23.5)) + (funcall regular-response seconds-difference (* 60 60) "hour")) + ((< seconds-difference (* 1.5 60 60 24)) + (cons "1 day ago" + (* 1.5 60 60 24))) ;; at a day and a half + ((< seconds-difference (* 60 60 24 6.5)) + (funcall regular-response seconds-difference (* 60 60 24) "day")) + ((< seconds-difference (* 1.5 60 60 24 7)) + (cons "1 week ago" + (* 1.5 60 60 24 7))) ;; a week and a half + ((< seconds-difference (* 60 60 24 7 52)) + (if (= 52 (floor (+ 0.5 (/ seconds-difference 60 60 24 7)))) + (cons "52 weeks ago" + (* 60 60 24 7 52)) + (funcall regular-response seconds-difference (* 60 60 24 7) "week"))) + ((< seconds-difference (* 1.5 60 60 24 365)) + (cons "1 year ago" + (* 60 60 24 365 1.5))) ;; a year and a half + (t + (funcall regular-response seconds-difference (* 60 60 24 365.25) "year"))))) + (cons (car relative-result) + (time-add timestamp (seconds-to-time (cdr relative-result)))))) + +(defun mastodon-tl--relative-time-description (timestamp &optional current-time) + "Return a string with a human readable TIMESTAMP relative to the current time. +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). +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))) + + +;;; RENDERING HTML, LINKS, HASHTAGS, HANDLES (defun mastodon-tl--render-text (string &optional toot) "Return a propertized text rendering the given HTML string STRING. @@ -933,40 +845,8 @@ the toot)." ;; If nothing matches we assume it is not a hashtag link: (t nil))) -(defun mastodon-tl--set-face (string face) - "Return the propertized STRING with the face property set to FACE." - (propertize string 'face face)) - -(defun mastodon-tl--toggle-spoiler-text (position) - "Toggle the visibility of the spoiler text at/after POSITION." - (let ((inhibit-read-only t) - (spoiler-text-region (mastodon-tl--find-property-range - 'mastodon-content-warning-body position nil))) - (if (not spoiler-text-region) - (message "No spoiler text here") - (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) - (list 'invisible - (not (get-text-property (car spoiler-text-region) - 'invisible))))))) - -(defun mastodon-tl--toggle-spoiler-text-in-toot () - "Toggle the visibility of the spoiler text in the current toot." - (interactive) - (let* ((toot-range (or (mastodon-tl--find-property-range - 'toot-json (point)) - (mastodon-tl--find-property-range - 'toot-json (point) t))) - (spoiler-range (when toot-range - (mastodon-tl--find-property-range - 'mastodon-content-warning-body - (car toot-range))))) - (cond ((null toot-range) - (message "No toot here")) - ((or (null spoiler-range) - (> (car spoiler-range) (cdr toot-range))) - (message "No content warning text here")) - (t - (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) + +;;; HYPERLINKS (defun mastodon-tl--make-link (string link-type) "Return a propertized version of STRING that will act like link. @@ -985,7 +865,7 @@ LINK-TYPE is the type of link to produce." (defun mastodon-tl--do-link-action-at-point (position) "Do the action of the link at POSITION. -Used for hitting <return> on a given link." +Used for hitting RET on a given link." (interactive "d") (let ((link-type (get-text-property position 'mastodon-tab-stop))) (cond ((eq link-type 'content-warning) @@ -1024,6 +904,9 @@ Used for a mouse-click EVENT on a link." (interactive "e") (mastodon-tl--do-link-action-at-point (posn-point (event-end event)))) + +;;; CONTENT WARNINGS + (defun mastodon-tl--has-spoiler (toot) "Check if the given TOOT has a spoiler text. Spoiler text should initially be shown only while the main @@ -1031,6 +914,37 @@ content should be hidden." (let ((spoiler (mastodon-tl--field 'spoiler_text toot))) (and spoiler (> (length spoiler) 0)))) +(defun mastodon-tl--toggle-spoiler-text (position) + "Toggle the visibility of the spoiler text at/after POSITION." + (let ((inhibit-read-only t) + (spoiler-text-region (mastodon-tl--find-property-range + 'mastodon-content-warning-body position nil))) + (if (not spoiler-text-region) + (message "No spoiler text here") + (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) + (list 'invisible + (not (get-text-property (car spoiler-text-region) + 'invisible))))))) + +(defun mastodon-tl--toggle-spoiler-text-in-toot () + "Toggle the visibility of the spoiler text in the current toot." + (interactive) + (let* ((toot-range (or (mastodon-tl--find-property-range + 'toot-json (point)) + (mastodon-tl--find-property-range + 'toot-json (point) t))) + (spoiler-range (when toot-range + (mastodon-tl--find-property-range + 'mastodon-content-warning-body + (car toot-range))))) + (cond ((null toot-range) + (message "No toot here")) + ((or (null spoiler-range) + (> (car spoiler-range) (cdr toot-range))) + (message "No content warning text here")) + (t + (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) + (defun mastodon-tl--clean-tabs-and-nl (string) "Remove tabs and newlines from STRING." (replace-regexp-in-string @@ -1071,6 +985,9 @@ message is a link which unhides/hides the main body." t) 'mastodon-content-warning-body t)))) + +;;; MEDIA + (defun mastodon-tl--media (toot) "Retrieve a media attachment link for TOOT if one exists." (let* ((media-attachments (mastodon-tl--field 'media_attachments toot)) @@ -1136,6 +1053,9 @@ HELP-ECHO, DISPLAY, and FACE are the text properties to add." help-echo (concat help-echo "\nC-RET: play " type " with mpv")))) + +;;; INSERT TOOTS + (defun mastodon-tl--content (toot) "Retrieve text content from TOOT. Runs `mastodon-tl--render-text' and fetches poll or media." @@ -1157,17 +1077,14 @@ BODY will form the section of the toot above the byline. AUTHOR-BYLINE is an optional function for adding the author portion of the byline that takes one variable. By default it is `mastodon-tl--byline-author'. - ACTION-BYLINE is also an optional 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'. - ID is that of the status if it is a notification, which is attached as a `toot-id' property if provided. If the status is a favourite or boost notification, BASE-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))) @@ -1191,6 +1108,65 @@ this just means displaying toot client." (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) +;; from mastodon-alt.el: +(defun mastodon-tl--toot-for-stats (&optional toot) + "Return the TOOT on which we want to extract stats. +If no TOOT is given, the one at point is considered." + (let* ((original-toot (or toot (get-text-property (point) 'toot-json))) + (toot (or (alist-get 'status original-toot) + (when (alist-get 'type original-toot) + original-toot) + (alist-get 'reblog original-toot) + original-toot)) + (type (alist-get 'type (or toot)))) + (unless (member type '("follow" "follow_request")) + toot))) + +(defun mastodon-tl--toot-stats (toot) + "Return a right aligned string (using display align-to). +String is filled with TOOT statistics (boosts, favs, replies). +When the TOOT is a reblog (boost), statistics from reblogged +toots are returned. +To disable showing the stats, customize +`mastodon-tl--show-stats'." + (when-let ((toot (mastodon-tl--toot-for-stats toot))) + (let* ((favourites-count (alist-get 'favourites_count toot)) + (favourited (equal 't (alist-get 'favourited toot))) + (faves-prop (propertize (format "%s" favourites-count) + 'favourites-count favourites-count)) + (boosts-count (alist-get 'reblogs_count toot)) + (boosted (equal 't (alist-get 'reblogged toot))) + (boosts-prop (propertize (format "%s" boosts-count) + 'boosts-count boosts-count)) + (replies-count (alist-get 'replies_count toot)) + (favourites (format "%s %s" faves-prop ;favourites-count + (mastodon-tl--symbol 'favourite))) + (boosts (format "%s %s" boosts-prop ;boosts-count + (mastodon-tl--symbol 'boost))) + (replies (format "%s %s" replies-count (mastodon-tl--symbol 'reply))) + (status (concat + (propertize favourites + 'favourited-p favourited + 'favourites-field t + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) + (propertize boosts + 'boosted-p boosted + 'boosts-field t + 'face font-lock-comment-face) + (propertize " | " 'face font-lock-comment-face) + (propertize replies + 'replies-field t + 'replies-count replies-count + 'face font-lock-comment-face))) + (status (concat + (propertize " " 'display `(space :align-to (- right ,(+ (length status) 7)))) + status))) + status))) + + +;; POLLS + (defun mastodon-tl--get-poll (toot) "If TOOT includes a poll, return it as a formatted string." (let* ((poll (mastodon-tl--field 'poll toot)) @@ -1200,9 +1176,7 @@ this just means displaying toot client." (voters-count (mastodon-tl--field 'voters_count poll)) (vote-count (mastodon-tl--field 'votes_count poll)) (options (mastodon-tl--field 'options poll)) - (option-titles (mapcar (lambda (x) - (alist-get 'title x)) - options)) + (option-titles (mastodon-tl--map-alist 'title options)) (longest-option (car (sort option-titles (lambda (x y) (> (length x) @@ -1245,8 +1219,6 @@ this just means displaying toot client." (defun mastodon-tl--format-poll-expiry (timestamp) "Convert poll expiry TIMESTAMP into a descriptive string." - ;; TODO: this bugged when a timestamp was in the past - ;; despite the poll not being listed as expired (let ((parsed (ts-human-duration (ts-diff (ts-parse timestamp) (ts-now))))) (cond ((> (plist-get parsed :days) 0) @@ -1270,14 +1242,10 @@ this just means displaying toot client." (poll (or (alist-get 'poll reblog) (mastodon-tl--field 'poll toot))) (options (mastodon-tl--field 'options poll)) - (options-titles (mapcar (lambda (x) - (alist-get 'title x)) - options)) + (options-titles (mastodon-tl--map-alist 'title options)) (options-number-seq (number-sequence 1 (length options))) - (options-numbers (mapcar (lambda(x) - (number-to-string x)) - options-number-seq)) - (options-alist (cl-mapcar 'cons options-numbers options-titles)) + (options-numbers (mapcar #'number-to-string options-number-seq)) + (options-alist (cl-mapcar #'cons options-numbers options-titles)) ;; we display both option number and the option title ;; but also store both as cons cell as cdr, as we need it below (candidates (mapcar (lambda (cell) @@ -1308,6 +1276,9 @@ this just means displaying toot client." (message "You voted for option %s: %s!" (car option) (cdr option))))))) + +;; VIDEOS / MPV + (defun mastodon-tl--find-first-video-in-attachments () "Return the first media attachment that is a moving image." (let ((attachments (mastodon-tl--property 'attachments)) @@ -1337,11 +1308,11 @@ in which case play first video or gif from current toot." ;; point in byline: url ;; point in toot: - (get-text-property (point) 'image-url))) + (mastodon-tl--property 'image-url :no-move))) (type (or ;; in byline: type ;; point in toot: - (mastodon-tl--property 'mastodon-media-type)))) + (mastodon-tl--property 'mastodon-media-type :no-move)))) (if url (if (or (equal type "gifv") (equal type "video")) @@ -1351,13 +1322,16 @@ in which case play first video or gif from current toot." (message "no moving image here?")) (message "no moving image here?")))) + +;; INSERT TOOTS + (defun mastodon-tl--is-reply (toot) "Check if the TOOT is a reply to another one (and not boosted)." (and (null (mastodon-tl--field 'in_reply_to_id toot)) (not (mastodon-tl--field 'rebloged toot)))) (defun mastodon-tl--toot (toot &optional detailed-p) - "Formats TOOT and inserts it into the buffer. + "Format TOOT and insert it into the buffer. DETAILED-P means display more detailed info. For now this just means displaying toot client." (mastodon-tl--insert-status @@ -1375,7 +1349,7 @@ this just means displaying toot client." (defun mastodon-tl--timeline (toots) "Display each toot in TOOTS. This function removes replies if user required." - (mapc 'mastodon-tl--toot + (mapc #'mastodon-tl--toot ;; hack to *not* filter replies on profiles: (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) toots @@ -1387,6 +1361,9 @@ This function removes replies if user required." toots))) (goto-char (point-min))) + +;;; BUFFER SPEC + (defun mastodon-tl--get-update-function (&optional buffer) "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." @@ -1443,6 +1420,9 @@ HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer." update-params ,update-params hide-replies ,hide-replies))) + +;;; BUFFERS + (defun mastodon-tl--get-buffer-type () "Return a symbol descriptive of current mastodon buffer type. Should work in all mastodon buffers. @@ -1450,7 +1430,7 @@ Note that for many buffers, this requires `mastodon-tl--buffer-spec' to be set. It is set for almost all buffers, but you still have to call this function after it is set or use something else." (let ((endpoint-fun (mastodon-tl--get-endpoint nil :no-error)) - (buffer-name-fun (mastodon-tl--buffer-name nil :no-error))) + (buffer-name (mastodon-tl--buffer-name nil :no-error))) (cond (mastodon-toot-mode ;; composing/editing: (if (string= "*edit toot*" (buffer-name)) @@ -1459,7 +1439,7 @@ call this function after it is set or use something else." ;; main timelines: ((string= "timelines/home" endpoint-fun) 'home) - ((string= "*mastodon-local*" buffer-name-fun) + ((string= "*mastodon-local*" buffer-name) 'local) ((string= "timelines/public" endpoint-fun) 'federated) @@ -1468,7 +1448,7 @@ call this function after it is set or use something else." ((string-prefix-p "timelines/list/" endpoint-fun) 'list-timeline) ;; notifs: - ((string-suffix-p "mentions*" buffer-name-fun) + ((string-suffix-p "mentions*" buffer-name) 'mentions) ((string= "notifications" endpoint-fun) 'notifications) @@ -1481,13 +1461,17 @@ call this function after it is set or use something else." ((mastodon-tl--profile-buffer-p) (cond ;; own profile: - ((equal (mastodon-tl--buffer-name) - (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) - 'own-profile) + ;; perhaps not needed, and needlessly confusing, + ;; e.g. for `mastodon-profile--account-view-cycle': + ;; ((equal (mastodon-tl--buffer-name) + ;; (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) + ;; 'own-profile-statuses) ;; profile note: - ((string-suffix-p "update-profile*" buffer-name-fun) + ((string-suffix-p "update-profile*" buffer-name) 'update-profile-note) - ;; posts + ;; posts inc. boosts: + ((string-suffix-p "no-boosts*" buffer-name) + 'profile-statuses-no-boosts) ((string-suffix-p "statuses" endpoint-fun) 'profile-statuses) ;; profile followers @@ -1521,7 +1505,7 @@ call this function after it is set or use something else." ;; instance description ((string= "instance" endpoint-fun) 'instance-description) - ((string= "*mastodon-toot-edits*" buffer-name-fun) + ((string= "*mastodon-toot-edits*" buffer-name) 'toot-edits)))) (defun mastodon-tl--buffer-type-eq (type) @@ -1533,19 +1517,6 @@ call this function after it is set or use something else." This includes the update profile note buffer, but not the preferences one." (string-prefix-p "accounts" (mastodon-tl--get-endpoint nil :no-error))) -(defun mastodon-tl--has-toots-p () - "Return non-nil if the current buffer contains toots. -Return value is that of `member'. -This is used to avoid running into trouble using functions that -presume we are in a timeline of toots or similar elements, such as -`mastodon-tl--property'." - (let ((toot-buffers - '(home federated local tag-timeline notifications - thread profile-statuses search trending-tags bookmarks - favourites))) - ;; profile-followers profile following - (member (mastodon-tl--get-buffer-type) toot-buffers))) - (defun mastodon-tl--timeline-proper-p () "Return non-nil if the current buffer is a 'proper' timeline. A proper timeline excludes notifications, threads, and other toot @@ -1567,42 +1538,62 @@ timeline." ;; Timeline called with C-u prefix (equal '(4) prefix)))) -(defun mastodon-tl--more-json (endpoint id) - "Return JSON for timeline ENDPOINT before ID." - (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url args))) + +;;; UTILITIES -(defun mastodon-tl--more-json-async (endpoint id &optional params callback &rest cbargs) - "Return JSON for timeline ENDPOINT before ID. -Then run CALLBACK with arguments CBARGS. -PARAMS is used to send any parameters needed to correctly update -the current view." - (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push (car args) params) args)) - (url (mastodon-http--api endpoint))) - (apply 'mastodon-http--get-json-async url args callback cbargs))) +(defun mastodon-tl--map-alist (key alist) + "Return a list of values extracted from ALIST with KEY. +Key is a symbol, as with `alist-get'." + (mapcar (lambda (x) + (alist-get key x)) + alist)) -;; TODO -;; Look into the JSON returned here by Local -(defun mastodon-tl--updated-json (endpoint id &optional params) - "Return JSON for timeline ENDPOINT since ID. -PARAMS is used to send any parameters needed to correctly update -the current view." - (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) - (args (if params (push (car args) params) args)) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url args))) +(defun mastodon-tl--map-alist-vals-to-alist (key1 key2 alist) + "From ALIST, return an alist consisting of (val1 . val2) elements. +Values are accessed by `alist-get', using KEY1 and KEY2." + (mapcar (lambda (x) + (cons (alist-get key1 x) + (alist-get key2 x))) + alist)) -(defun mastodon-tl--property (prop &optional backward) +(defun mastodon-tl--symbol (name) + "Return the unicode symbol (as a string) corresponding to NAME. +If symbol is not displayable, an ASCII equivalent is returned. If +NAME is not part of the symbol table, '?' is returned." + (if-let* ((symbol (alist-get name mastodon-tl--symbols))) + (if (char-displayable-p (string-to-char (car symbol))) + (car symbol) + (cdr symbol)) + "?")) + +(defun mastodon-tl--set-face (string face) + "Return the propertized STRING with the face property set to FACE." + (propertize string 'face face)) + +(defun mastodon-tl--field (field toot) + "Return FIELD from TOOT. +Return value from boosted content if available." + (or (alist-get field (alist-get 'reblog toot)) + (alist-get field toot))) + +(defun mastodon-tl--remove-html (toot) + "Remove unrendered tags from TOOT." + (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) + (t2 (replace-regexp-in-string "<\/?span>" "" t1))) + (replace-regexp-in-string "<span class=\"h-card\">" "" t2))) + +(defun mastodon-tl--property (prop &optional no-move backward) "Get property PROP for toot at point. -Move forward (down) the timeline unless BACKWARD is non-nil." - (or (get-text-property (point) prop) - (save-excursion - (if backward - (mastodon-tl--goto-prev-toot) - (mastodon-tl--goto-next-toot)) - (get-text-property (point) prop)))) +Move forward (down) the timeline unless NO-MOVE is non-nil. +BACKWARD means move backward (up) the timeline." + (if no-move + (get-text-property (point) prop) + (or (get-text-property (point) prop) + (save-excursion + (if backward + (mastodon-tl--goto-prev-toot) + (mastodon-tl--goto-next-toot)) + (get-text-property (point) prop))))) (defun mastodon-tl--newest-id () "Return toot-id from the top of the buffer." @@ -1614,7 +1605,7 @@ Move forward (down) the timeline unless BACKWARD is non-nil." "Return toot-id from the bottom of the buffer." (save-excursion (goto-char (point-max)) - (mastodon-tl--property 'toot-id t))) + (mastodon-tl--property 'toot-id nil :backward))) (defun mastodon-tl--as-string (numeric) "Convert NUMERIC to string." @@ -1635,6 +1626,7 @@ webapp" (reblog (alist-get 'reblog json))) (if reblog (alist-get 'id reblog) id))) + ;;; THREADS (defun mastodon-tl--single-toot (id) @@ -1648,6 +1640,7 @@ ID is that of the toot to view." (message "Error: %s" (cdar toot)) (with-current-buffer (get-buffer-create buffer) (let ((inhibit-read-only t)) + (erase-buffer) (switch-to-buffer buffer) (mastodon-mode) (mastodon-tl--set-buffer-spec buffer @@ -1670,12 +1663,9 @@ view all branches of a thread." (defun mastodon-tl--thread (&optional id) "Open thread buffer for toot at point or with ID." - ;; NB: this is called by `mastodon-url-lookup', which means it must work - ;; without `mastodon-tl--buffer-spec' being set! - ;; so avoid calls to `mastodon-tl--property' and friends (interactive) - (let* ((id (or id (get-text-property (point) 'base-toot-id))) - (type (mastodon-tl--field 'type (get-text-property (point) 'toot-json)))) + (let* ((id (or id (mastodon-tl--property 'base-toot-id :no-move))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'toot-json :no-move)))) (if (or (string= type "follow_request") (string= type "follow")) ; no can thread these (error "No thread") @@ -1702,6 +1692,7 @@ view all branches of a thread." (with-current-buffer (get-buffer-create buffer) (let ((inhibit-read-only t)) (switch-to-buffer buffer) + (erase-buffer) (mastodon-mode) (mastodon-tl--set-buffer-spec buffer endpoint @@ -1757,6 +1748,13 @@ If UNMUTE, unmute it." (message "Thread unmuted!") (message "Thread muted!"))))))))))) +(defun mastodon-tl--map-account-id-from-toot (statuses) + "Return a list of the account IDs of the author of each toot in STATUSES." + (mapcar (lambda (status) + (alist-get 'id + (alist-get 'account status))) + statuses)) + (defun mastodon-tl--user-in-thread-p (id) "Return non-nil if the logged-in user has posted to the current thread. ID is that of the post the context is currently displayed for." @@ -1765,715 +1763,28 @@ ID is that of the post the context is currently displayed for." nil :silent)) (ancestors (alist-get 'ancestors context-json)) (descendants (alist-get 'descendants context-json)) - (a-ids (mapcar (lambda (status) - (alist-get 'id - (alist-get 'account status))) - ancestors)) - (d-ids (mapcar (lambda (status) - (alist-get 'id - (alist-get 'account status))) - descendants))) + (a-ids (mastodon-tl--map-account-id-from-toot ancestors)) + (d-ids (mastodon-tl--map-account-id-from-toot descendants))) (or (member (mastodon-auth--get-account-id) a-ids) (member (mastodon-auth--get-account-id) d-ids)))) -;;; LISTS - -(defun mastodon-tl--get-users-lists () - "Get the list of the user's lists from the server." - (let ((url (mastodon-http--api "lists"))) - (mastodon-http--get-json url))) - -(defun mastodon-tl--get-lists-names () - "Return a list of the user's lists' names." - (let ((lists (mastodon-tl--get-users-lists))) - (mapcar (lambda (x) - (alist-get 'title x)) - lists))) - -(defun mastodon-tl--get-list-by-name (name) - "Return the list data for list with NAME." - (let* ((lists (mastodon-tl--get-users-lists))) - (cl-loop for list in lists - if (string= (alist-get 'title list) name) - return list))) - -(defun mastodon-tl--get-list-id (name) - "Return id for list with NAME." - (let ((list (mastodon-tl--get-list-by-name name))) - (alist-get 'id list))) - -(defun mastodon-tl--get-list-name (id) - "Return name of list with ID." - (let* ((url (mastodon-http--api (format "lists/%s" id))) - (response (mastodon-http--get-json url))) - (alist-get 'title response))) - -(defun mastodon-tl--edit-list-at-point () - "Edit list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--edit-list id))) - -(defun mastodon-tl--edit-list (&optional id) - "Prompt for a list and edit the name and replies policy. -If ID is provided, use that list." - (interactive) - (let* ((list-names (unless id (mastodon-tl--get-lists-names))) - (name-old (if id - (get-text-property (point) 'list-name) - (completing-read "Edit list: " - list-names))) - (id (or id (mastodon-tl--get-list-id name-old))) - (name-choice (read-string "List name: " name-old)) - (replies-policy (completing-read "Replies policy: " ; give this a proper name - '("followed" "list" "none") - nil t nil nil "list")) - (url (mastodon-http--api (format "lists/%s" id))) - (response (mastodon-http--put url - `(("title" . ,name-choice) - ("replies_policy" . ,replies-policy))))) - (mastodon-http--triage response - (lambda () - (with-current-buffer response - (let* ((json (mastodon-http--process-json)) - (name-new (alist-get 'title json))) - (message "list %s edited to %s!" name-old name-new))) - (when (mastodon-tl--buffer-type-eq 'lists) - (mastodon-tl--view-lists)))))) - -(defun mastodon-tl--view-timeline-list-at-point () - "View timeline of list at point." - (interactive) - (let ((list-id (get-text-property (point) 'list-id))) - (mastodon-tl--view-list-timeline list-id))) - -(defun mastodon-tl--view-list-timeline (&optional id) - "Prompt for a list and view its timeline. -If ID is provided, use that list." - (interactive) - (let* ((list-names (unless id (mastodon-tl--get-lists-names))) - (list-name (unless id (completing-read "View list: " list-names))) - (id (or id (mastodon-tl--get-list-id list-name))) - (endpoint (format "timelines/list/%s" id)) - (name (mastodon-tl--get-list-name id)) - (buffer-name (format "list-%s" name))) - (mastodon-tl--init buffer-name endpoint 'mastodon-tl--timeline))) - -(defun mastodon-tl--create-list () - "Create a new list. -Prompt for name and replies policy." - (interactive) - (let* ((title (read-string "New list name: ")) - (replies-policy (completing-read "Replies policy: " ; give this a proper name - '("followed" "list" "none") - nil t nil nil "list")) ; default - (response (mastodon-http--post (mastodon-http--api "lists") - `(("title" . ,title) - ("replies_policy" . ,replies-policy)) - nil))) - (mastodon-tl--list-action-triage response - (message "list %s created!" title)))) - -(defun mastodon-tl--delete-list-at-point () - "Delete list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--delete-list id))) - -(defun mastodon-tl--delete-list (&optional id) - "Prompt for a list and delete it. -If ID is provided, delete that list." - (interactive) - (let* ((list-names (unless id (mastodon-tl--get-lists-names))) - (name (if id - (mastodon-tl--get-list-name id) - (completing-read "Delete list: " - list-names))) - (id (or id (mastodon-tl--get-list-id name))) - (url (mastodon-http--api (format "lists/%s" id)))) - (when (y-or-n-p (format "Delete list %s?" name)) - (let ((response (mastodon-http--delete url))) - (mastodon-tl--list-action-triage response - (message "list %s deleted!" name)))))) - -(defun mastodon-tl--view-lists () - "Show the user's lists in a new buffer." - (interactive) - (mastodon-tl--init-sync "lists" - "lists" - 'mastodon-tl--insert-lists) - (use-local-map mastodon-tl--view-lists-keymap)) - -(defun mastodon-tl--insert-lists (_json) - "Insert the user's lists from JSON." - ;; TODO: for now we don't use the JSON, we get it ourself again - (let* ((lists-names (mastodon-tl--get-lists-names))) - (erase-buffer) - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " YOUR LISTS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[C - create a list\n D - delete a list\ -\n A/R - add/remove account from a list\ -\n E - edit a list\n n/p - go to next/prev item]\n\n" - 'font-lock-comment-face)) - (mapc (lambda (x) - (mastodon-tl--print-list-accounts x) - (insert (propertize " ------------\n\n" - 'face 'success))) - lists-names) - (goto-char (point-min)))) -;; (mastodon-tl--goto-next-item))) ; causes another request! - -(defun mastodon-tl--print-list-accounts (list-name) - "Insert the accounts in list named LIST-NAME." - (let* ((id (mastodon-tl--get-list-id list-name)) - (accounts (mastodon-tl--accounts-in-list id))) - (insert - (propertize list-name - 'byline t ; so we nav here - 'toot-id "0" ; so we nav here - 'help-echo "RET: view list timeline, d: delete this list, \ -a: add account to this list, r: remove account from this list" - 'list t - 'face 'link - 'keymap mastodon-tl--list-name-keymap - 'list-name list-name - 'list-id id) - (propertize - "\n\n" - 'list t - 'keymap mastodon-tl--list-name-keymap - 'list-name list-name - 'list-id id) - (propertize - (mapconcat #'mastodon-search--propertize-user accounts - " ") - ;; (mastodon-search--insert-users-propertized accounts) - 'list t - 'keymap mastodon-tl--list-name-keymap - 'list-name list-name - 'list-id id)))) - -(defun mastodon-tl--get-users-followings () - "Return the list of followers of the logged in account." - (let* ((id (mastodon-auth--get-account-id)) - (url (mastodon-http--api (format "accounts/%s/following" id)))) - (mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts - -(defun mastodon-tl--add-account-to-list-at-point () - "Prompt for account and add to list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--add-account-to-list id))) - -(defun mastodon-tl--add-account-to-list (&optional id account-id handle) - "Prompt for a list and for an account, add account to list. -If ID is provided, use that list. -If ACCOUNT-ID and HANDLE are provided use them rather than prompting." - (interactive) - (let* ((list-prompt (if handle - (format "Add %s to list: " handle) - "Add account to list: ")) - (list-name (if id - (get-text-property (point) 'list-name) - (completing-read list-prompt - (mastodon-tl--get-lists-names) nil t))) - (list-id (or id (mastodon-tl--get-list-id list-name))) - (followings (mastodon-tl--get-users-followings)) - (handles (mapcar (lambda (x) - (cons (alist-get 'acct x) - (alist-get 'id x))) - followings)) - (account (or handle (completing-read "Account to add: " - handles nil t))) - (account-id (or account-id (alist-get account handles nil nil 'equal))) - (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (response (mastodon-http--post url - `(("account_ids[]" . ,account-id))))) - (mastodon-tl--list-action-triage - response - (message "%s added to list %s!" account list-name)))) - -(defun mastodon-tl--add-toot-account-at-point-to-list () - "Prompt for a list, and add the account of the toot at point to it." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (account (mastodon-tl--field 'account toot)) - (account-id (mastodon-tl--field 'id account)) - (handle (mastodon-tl--field 'acct account))) - (mastodon-tl--add-account-to-list nil account-id handle))) - -(defun mastodon-tl--remove-account-from-list-at-point () - "Prompt for account and remove from list at point." - (interactive) - (let ((id (get-text-property (point) 'list-id))) - (mastodon-tl--remove-account-from-list id))) - -(defun mastodon-tl--remove-account-from-list (&optional id) - "Prompt for a list, select an account and remove from list. -If ID is provided, use that list." - (interactive) - (let* ((list-name (if id - (get-text-property (point) 'list-name) - (completing-read "Remove account from list: " - (mastodon-tl--get-lists-names) nil t))) - (list-id (or id (mastodon-tl--get-list-id list-name))) - (accounts (mastodon-tl--accounts-in-list list-id)) - (handles (mapcar (lambda (x) - (cons (alist-get 'acct x) - (alist-get 'id x))) - accounts)) - (account (completing-read "Account to remove: " - handles nil t)) - (account-id (alist-get account handles nil nil 'equal)) - (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) - (response (mastodon-http--delete url args))) - (mastodon-tl--list-action-triage - response - (message "%s removed from list %s!" account list-name)))) - -(defun mastodon-tl--list-action-triage (response message) - "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." - (mastodon-http--triage response - (lambda () - (when (mastodon-tl--buffer-type-eq 'lists) - (mastodon-tl--view-lists)) - message))) - -(defun mastodon-tl--accounts-in-list (list-id) - "Return the JSON of the accounts in list with LIST-ID." - (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) - (mastodon-http--get-json url))) - -;;; SCHEDULED TOOTS - -(defun mastodon-tl--get-scheduled-toots (&optional id) - "Get the user's currently scheduled toots. -If ID, just return that toot." - (let* ((endpoint (if id - (format "scheduled_statuses/%s" id) - "scheduled_statuses")) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url))) - -(defun mastodon-tl--reschedule-toot () - "Reschedule the scheduled toot at point." - (interactive) - (mastodon-toot--schedule-toot :reschedule)) - -(defun mastodon-tl--view-scheduled-toots () - "Show the user's scheduled toots in a new buffer." - (interactive) - (mastodon-tl--init-sync "scheduled-toots" - "scheduled_statuses" - 'mastodon-tl--insert-scheduled-toots)) - -(defun mastodon-tl--insert-scheduled-toots (json) - "Insert the user's scheduled toots, from JSON." - (let ((scheduleds (mastodon-tl--get-scheduled-toots))) - (erase-buffer) - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " YOUR SCHEDULED TOOTS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[n/p - prev/next\n r - reschedule\n e/RET - edit toot\n c - cancel]\n\n" - 'font-lock-comment-face)) - (mapc (lambda (x) - (mastodon-tl--insert-scheduled-toot x)) - scheduleds) - (goto-char (point-min)) - (when json - (mastodon-tl--goto-next-toot)))) - -(defun mastodon-tl--insert-scheduled-toot (toot) - "Insert scheduled TOOT into the buffer." - (let* ((id (alist-get 'id toot)) - (scheduled (alist-get 'scheduled_at toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params))) - (insert - (propertize (concat text - " | " - (mastodon-toot--iso-to-human scheduled)) - 'byline t ; so we nav here - 'toot-id "0" ; so we nav here - 'face 'font-lock-comment-face - 'keymap mastodon-tl--scheduled-map - 'scheduled-json toot - 'id id) - "\n"))) - -(defun mastodon-tl--copy-scheduled-toot-text () - "Copy the text of the scheduled toot at point." - (interactive) - (let* ((toot (get-text-property (point) 'toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params))) - (kill-new text))) - -(defun mastodon-tl--cancel-scheduled-toot (&optional id no-confirm) - "Cancel the scheduled toot at point. -ID is that of the scheduled toot to cancel. -NO-CONFIRM means there is no ask or message, there is only do." - (interactive) - (let* ((id (or id (get-text-property (point) 'id))) - (url (mastodon-http--api (format "scheduled_statuses/%s" id)))) - (when (or no-confirm - (y-or-n-p "Cancel scheduled toot?")) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda () - (mastodon-tl--view-scheduled-toots) - (unless no-confirm - (message "Toot cancelled!")))))))) - -(defun mastodon-tl--edit-scheduled-as-new () - "Edit scheduled status as new toot." - (interactive) - (let* ((toot (get-text-property (point) 'scheduled-json)) - (id (alist-get 'id toot)) - (scheduled (alist-get 'scheduled_at toot)) - (params (alist-get 'params toot)) - (text (alist-get 'text params)) - (visibility (alist-get 'visibility params)) - (cw (alist-get 'spoiler_text params)) - (lang (alist-get 'language params)) - ;; (poll (alist-get 'poll params)) - (reply-id (alist-get 'in_reply_to_id params))) - ;; (media (alist-get 'media_attachments toot))) - (mastodon-toot--compose-buffer) - (goto-char (point-max)) - (insert text) - ;; adopt properties from scheduled toot: - (mastodon-toot--set-toot-properties reply-id visibility cw - lang scheduled id))) - -;;; FILTERS - -(defun mastodon-tl--create-filter () - "Create a filter for a word. -Prompt for a context, must be a list containting at least one of \"home\", -\"notifications\", \"public\", \"thread\"." - (interactive) - (let* ((url (mastodon-http--api "filters")) - (word (read-string - (format "Word(s) to filter (%s): " (or (current-word) "")) - nil nil (or (current-word) ""))) - (contexts - (if (string-empty-p word) - (error "You must select at least one word for a filter") - (completing-read-multiple - "Contexts to filter [TAB for options]: " - '("home" "notifications" "public" "thread") - nil ; no predicate - t))) ; require-match, as context is mandatory - (contexts-processed - (if (equal nil contexts) - (error "You must select at least one context for a filter") - (mapcar (lambda (x) - (cons "context[]" x)) - contexts))) - (response (mastodon-http--post url (push - `("phrase" . ,word) - contexts-processed)))) - (mastodon-http--triage response - (lambda () - (message "Filter created for %s!" word) - ;; reload if we are in filters view: - (when (mastodon-tl--buffer-type-eq 'filters) - (mastodon-tl--view-filters)))))) - -(defun mastodon-tl--view-filters () - "View the user's filters in a new buffer." - (interactive) - (mastodon-tl--init-sync "filters" - "filters" - 'mastodon-tl--insert-filters) - (use-local-map mastodon-tl--view-filters-keymap)) - -(defun mastodon-tl--insert-filters (json) - "Insert the user's current filters. -JSON is what is returned by by the server." - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " CURRENT FILTERS\n" - " ------------\n\n") - 'success) - (mastodon-tl--set-face - "[c - create filter\n d - delete filter at point\n n/p - go to next/prev filter]\n\n" - 'font-lock-comment-face)) - (if (seq-empty-p json) - (insert (propertize - "Looks like you have no filters for now." - 'face font-lock-comment-face - 'byline t - 'toot-id "0")) ; so point can move here when no filters - (mapc (lambda (x) - (mastodon-tl--insert-filter-string x) - (insert "\n\n")) - json))) - -(defun mastodon-tl--insert-filter-string (filter) - "Insert a single FILTER." - (let* ((phrase (alist-get 'phrase filter)) - (contexts (alist-get 'context filter)) - (id (alist-get 'id filter)) - (filter-string (concat "- \"" phrase "\" filtered in: " - (mapconcat #'identity contexts ", ")))) - (insert - (propertize filter-string - 'toot-id id ;for goto-next-filter compat - 'phrase phrase - ;;'help-echo "n/p to go to next/prev filter, c to create new filter, d to delete filter at point." - ;;'keymap mastodon-tl--view-filters-keymap - 'byline t)))) ;for goto-next-filter compat - -(defun mastodon-tl--delete-filter () - "Delete filter at point." - (interactive) - (let* ((filter-id (get-text-property (point) 'toot-id)) - (phrase (get-text-property (point) 'phrase)) - (url (mastodon-http--api - (format "filters/%s" filter-id)))) - (if (equal nil filter-id) - (error "No filter at point?") - (when (y-or-n-p (format "Delete this filter? "))) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response (lambda () - (mastodon-tl--view-filters) - (message "Filter for \"%s\" deleted!" phrase))))))) - -;;; FOLLOW SUGGESTIONS - -(defun mastodon-tl--get-follow-suggestions () - "Display a buffer of suggested accounts to follow." - (interactive) - (mastodon-tl--init-sync "follow-suggestions" - "suggestions" - 'mastodon-tl--insert-follow-suggestions) - (use-local-map mastodon-tl--follow-suggestions-map)) - -(defun mastodon-tl--insert-follow-suggestions (response) - "Insert follow suggestions into buffer. -RESPONSE is the JSON returned by the server." - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " SUGGESTED ACCOUNTS\n" - " ------------\n\n") - 'success)) - (mastodon-search--insert-users-propertized response :note) - (goto-char (point-min))) + +;;; FOLLOW/BLOCK/MUTE, ETC (defmacro mastodon-tl--do-if-toot (&rest body) "Execute BODY if we have a toot or user at point." (declare (debug t)) `(if (and (not (mastodon-tl--profile-buffer-p)) - (not (mastodon-tl--property 'toot-json))) + (not (mastodon-tl--property 'toot-json))) ; includes user listings (message "Looks like there's no toot or user at point?") ,@body)) -;;; INSTANCES - -(defun mastodon-tl--view-own-instance (&optional brief) - "View details of your own instance. -BRIEF means show fewer details." - (interactive) - (mastodon-tl--view-instance-description :user brief)) - -(defun mastodon-tl--view-own-instance-brief () - "View brief details of your own instance." - (interactive) - (mastodon-tl--view-instance-description :user :brief)) - -(defun mastodon-tl--view-instance-description-brief () - "View brief details of the instance the current post's author is on." - (interactive) - (mastodon-tl--view-instance-description nil :brief)) - -(defun mastodon-tl--view-instance-description (&optional user brief instance) - "View the details of the instance the current post's author is on. -USER means to show the instance details for the logged in user. -BRIEF means to show fewer details. -INSTANCE is an instance domain name." - (interactive) - (if user - (let ((response (mastodon-http--get-json - (mastodon-http--api "instance") - nil ; params - nil ; silent - :vector))) - (mastodon-tl--instance-response-fun response brief)) - (mastodon-tl--do-if-toot - (let* ((profile-p (get-text-property (point) 'profile-json)) - (toot (if profile-p - (mastodon-tl--property 'profile-json) ; profile may have 0 toots - (mastodon-tl--property 'toot-json))) - (reblog (alist-get 'reblog toot)) - (account (or (alist-get 'account reblog) - (alist-get 'account toot))) - (url (if profile-p - (alist-get 'url toot) ; profile - (alist-get 'url account))) - (username (if profile-p - (alist-get 'username toot) ;; profile - (alist-get 'username account))) - (instance (if instance - (concat "https://" instance) - ;; pleroma URL is https://instance.com/users/username - (if (string-suffix-p "users/" (url-basepath url)) - (string-remove-suffix "/users/" - (url-basepath url)) - ;; mastodon: - (string-remove-suffix (concat "/@" username) - url)))) - (response (mastodon-http--get-json - (if user - (mastodon-http--api "instance") - (concat instance "/api/v1/instance")) - nil ; params - nil ; silent - :vector))) - (mastodon-tl--instance-response-fun response brief instance))))) - -(defun mastodon-tl--instance-response-fun (response brief instance) - "Display instance description RESPONSE in a new buffer. -BRIEF means to show fewer details." - (when response - (let* ((domain (url-file-nondirectory instance)) - (buf (get-buffer-create - (format "*mastodon-instance-%s*" domain)))) - (with-current-buffer buf - (switch-to-buffer-other-window buf) - (let ((inhibit-read-only t)) - (erase-buffer) - (special-mode) - (when brief - (setq response - (list (assoc 'uri response) - (assoc 'title response) - (assoc 'short_description response) - (assoc 'email response) - (cons 'contact_account - (list - (assoc 'username - (assoc 'contact_account response)))) - (assoc 'rules response) - (assoc 'stats response)))) - (mastodon-tl--print-json-keys response) - (mastodon-mode) - (mastodon-tl--set-buffer-spec (buffer-name buf) - "instance" - nil) - (goto-char (point-min))))))) - -(defun mastodon-tl--format-key (el pad) - "Format a key of element EL, a cons, with PAD padding." - (format (concat "%-" - (number-to-string pad) - "s: ") - (propertize - (prin1-to-string (car el)) - 'face '(:underline t)))) - -(defun mastodon-tl--print-json-keys (response &optional ind) - "Print the JSON keys and values in RESPONSE. -IND is the optional indentation level to print at." - (let* ((cars (mapcar - (lambda (x) (symbol-name (car x))) - response)) - (pad (1+ (cl-reduce #'max (mapcar #'length cars))))) - (while response - (let ((el (pop response))) - (cond - ;; vector of alists (fields, instance rules): - ((and (vectorp (cdr el)) - (not (seq-empty-p (cdr el))) - (consp (seq-elt (cdr el) 0))) - (insert - (mastodon-tl--format-key el pad) - "\n\n") - (seq-do #'mastodon-tl--print-instance-rules-or-fields (cdr el)) - (insert "\n")) - ;; vector of strings (media types): - ((and (vectorp (cdr el)) - (not (seq-empty-p (cdr el))) - (< 1 (seq-length (cdr el))) - (stringp (seq-elt (cdr el) 0))) - (when ind (indent-to ind)) - (insert - (mastodon-tl--format-key el pad) - "\n" - (seq-mapcat - (lambda (x) (concat x ", ")) - (cdr el) 'string) - "\n\n")) - ;; basic nesting: - ((consp (cdr el)) - (when ind (indent-to ind)) - (insert - (mastodon-tl--format-key el pad) - "\n\n") - (mastodon-tl--print-json-keys - (cdr el) (if ind (+ ind 4) 4))) - (t - ;; basic handling of raw booleans: - (let ((val (cond ((equal (cdr el) ':json-false) - "no") - ((equal (cdr el) 't) - "yes") - (t - (cdr el))))) - (when ind (indent-to ind)) - (insert (mastodon-tl--format-key el pad) - " " - (mastodon-tl--newline-if-long (cdr el)) - ;; only send strings straight to --render-text - ;; this makes hyperlinks work: - (if (not (stringp val)) - (mastodon-tl--render-text - (prin1-to-string val)) - (mastodon-tl--render-text val)) - "\n")))))))) - -(defun mastodon-tl--print-instance-rules-or-fields (alist) - "Print ALIST of instance rules or contact account or emoji fields." - (let ((key (cond ((alist-get 'id alist) - 'id) - ((alist-get 'name alist) - 'name) - ((alist-get 'shortcode alist) - 'shortcode))) - (value (cond ((alist-get 'id alist) - 'text) - ((alist-get 'value alist) - 'value) - ((alist-get 'url alist) - 'url)))) - (indent-to 4) - (insert - (format "%-5s: " - (propertize (alist-get key alist) - 'face '(:underline t))) - (mastodon-tl--newline-if-long (alist-get value alist)) - (format "%s" (mastodon-tl--render-text - (alist-get value alist))) - "\n"))) - -(defun mastodon-tl--newline-if-long (el) - "Return a newline string if the cdr of EL is over 50 characters long." - (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) - (if (and (sequencep rend) - (< 50 (length rend))) - "\n" - ""))) - -;;; FOLLOW/BLOCK/MUTE, ETC +(defmacro mastodon-tl--do-if-toot-strict (&rest body) + "Execute BODY if we have a toot, and only a toot, at point." + (declare (debug t)) + `(if (not (mastodon-tl--property 'toot-id :no-move)) + (message "Looks like there's no toot at point?") + ,@body)) (defun mastodon-tl--follow-user (user-handle &optional notify langs) "Query for USER-HANDLE from current status and follow that user. @@ -2595,14 +1906,13 @@ LANGS is the accumulated array param alist if we re-run recursively." ;; fetch 'toot-json: (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following)) - (list (alist-get 'acct (get-text-property (point) 'toot-json)))) - ;; profile view, no toots, point on profile note, ie. 'profile-json: + (list (alist-get 'acct + (mastodon-tl--property 'toot-json :no-move)))) + ;; profile view, no toots ;; needed for e.g. gup.pe groups which show no toots publically: - ((and (mastodon-tl--profile-buffer-p) - (get-text-property (point) 'profile-json)) - (list (alist-get 'acct (get-text-property (point) 'profile-json)))) - ;; avoid tl--property here because it calls next-toot - ;; which breaks non-toot buffers like foll reqs etc.: + ((mastodon-tl--profile-buffer-p) + (list (alist-get 'acct + (mastodon-profile--profile-json)))) (t (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))))) @@ -2623,9 +1933,7 @@ Action must be either \"unblock\" or \"unmute\"." "mutes"))) (url (mastodon-http--api endpoint)) (json (mastodon-http--get-json url)) - (accts (mapcar (lambda (user) - (alist-get 'acct user)) - json))) + (accts (mastodon-tl--map-alist 'acct json))) (when accts (completing-read (format "Handle of user to %s: " action) accts @@ -2646,7 +1954,7 @@ LANGS is an array parameters alist of languages to filer user's posts by." ;; if profile view, use 'profile-json as status: (if (mastodon-tl--profile-buffer-p) (mastodon-profile--lookup-account-in-status - user-handle (get-text-property (point) 'profile-json)) + user-handle (mastodon-profile--profile-json)) ;; if muting/blocking, we select from handles in current status (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json))))) @@ -2690,13 +1998,9 @@ ARGS is an alist of any parameters to send with the request." ((eq notify nil) (message "User %s (@%s) %sed!" name user-handle action))))))) + ;; FOLLOW TAGS -(defun mastodon-tl--get-tag-json (tag) - "Return JSON data about TAG." - (let ((url (mastodon-http--api (format "tags/%s" tag)))) - (mastodon-http--get-json url))) - (defun mastodon-tl--follow-tag (&optional tag) "Prompt for a tag and follow it. If TAG provided, follow it." @@ -2718,9 +2022,8 @@ If TAG provided, follow it." If TAG is provided, unfollow it." (interactive) (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) - (tags (unless tag (mapcar (lambda (x) - (alist-get 'name x)) - followed-tags-json))) + (tags (unless tag + (mastodon-tl--map-alist 'name followed-tags-json))) (tag (or tag (completing-read "Unfollow tag: " tags))) (url (mastodon-http--api (format "tags/%s/unfollow" tag))) @@ -2733,12 +2036,38 @@ If TAG is provided, unfollow it." "List followed tags. View timeline of tag user choses." (interactive) (let* ((followed-tags-json (mastodon-tl--followed-tags)) - (tags (mapcar (lambda (x) - (alist-get 'name x)) - followed-tags-json)) + (tags (mastodon-tl--map-alist 'name followed-tags-json)) (tag (completing-read "Tag: " tags))) (mastodon-tl--get-tag-timeline tag))) + +;;; UPDATING, etc. + +(defun mastodon-tl--more-json (endpoint id) + "Return JSON for timeline ENDPOINT before ID." + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) + +(defun mastodon-tl--more-json-async (endpoint id &optional params callback &rest cbargs) + "Return JSON for timeline ENDPOINT before ID. +Then run CALLBACK with arguments CBARGS. +PARAMS is used to send any parameters needed to correctly update +the current view." + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (args (if params (push (car args) params) args)) + (url (mastodon-http--api endpoint))) + (apply #'mastodon-http--get-json-async url args callback cbargs))) + +(defun mastodon-tl--updated-json (endpoint id &optional params) + "Return JSON for timeline ENDPOINT since ID. +PARAMS is used to send any parameters needed to correctly update +the current view." + (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) + (args (if params (push (car args) params) args)) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) + ;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () "Reload the current timeline or profile page. @@ -2776,6 +2105,12 @@ when showing followers or accounts followed." (mastodon-tl--buffer-type-eq 'profile-followers) (mastodon-tl--buffer-type-eq 'profile-following))) +(defun mastodon-tl--get-link-header-from-response (headers) + "Get http Link header from list of http HEADERS." + ;; pleroma uses "link", so case-insensitive match required: + (when-let ((link-headers (alist-get "Link" headers nil nil 'cl-equalp))) + (split-string link-headers ", "))) + (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." (interactive) @@ -2830,7 +2165,6 @@ HEADERS is the http headers returned in the response, if any." "Return `nil` if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. - SEARCH-BACKWARDS determines whether we pick point before (non-nil) or after (nil)" (if (get-text-property start-point property) @@ -2865,9 +2199,7 @@ before (non-nil) or after (nil)" "Find (start . end) property range after/before START-POINT. Does so while PROPERTY is set to a consistent value (different from the value at START-POINT if that is set). - Return nil if no such range exists. - If SEARCH-BACKWARDS is non-nil it find a region before START-POINT otherwise after START-POINT." (if (get-text-property start-point property) @@ -2890,15 +2222,13 @@ START-POINT otherwise after START-POINT." This calculates the next time the text for TIMESTAMP will change and may adjust existing or future timer runs should that time before current plans to run the update function. - The adjustment is only made if it is significantly (a few seconds) before the currently scheduled time. This helps reduce the number of occasions where we schedule an update only to schedule the next one on completion to be within a few seconds. - -If relative timestamps are -disabled (`mastodon-tl--enable-relative-timestamps` is nil) this -is a no-op." +If relative timestamps are disabled (i.e. if +`mastodon-tl--enable-relative-timestamps' is nil), this is a +no-op." (when mastodon-tl--enable-relative-timestamps (let ((this-update (cdr (mastodon-tl--relative-time-details timestamp)))) (when (time-less-p this-update @@ -3012,11 +2342,8 @@ This location is defined by a non-nil value of (goto-char mastodon-tl--after-update-marker)))) (message "nothing to update"))))) -(defun mastodon-tl--get-link-header-from-response (headers) - "Get http Link header from list of http HEADERS." - ;; pleroma uses "link", so case-insensitive match required: - (when-let ((link-headers (alist-get "Link" headers nil nil 'cl-equalp))) - (split-string link-headers ", "))) + +;;; LOADING TIMELINES (defun mastodon-tl--init (buffer-name endpoint update-function &optional headers params hide-replies) @@ -3050,6 +2377,7 @@ JSON and http headers, without it just the JSON." (link-header (mastodon-tl--get-link-header-from-response headers))) (with-current-buffer (get-buffer-create buffer) (let ((inhibit-read-only t)) + (erase-buffer) (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. @@ -3102,6 +2430,7 @@ Optional arg NOTE-TYPE means only get that type of note." (json (mastodon-http--get-json url args))) (with-current-buffer (get-buffer-create buffer) (let ((inhibit-read-only t)) + (erase-buffer) (switch-to-buffer buffer) ;; mastodon-mode wipes buffer-spec, so order must unforch be: ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. @@ -3126,6 +2455,7 @@ Optional arg NOTE-TYPE means only get that type of note." (current-buffer) nil))) (unless (mastodon-tl--profile-buffer-p) + ;; FIXME: this breaks test (because test has empty buffer) (mastodon-tl--goto-first-item))) buffer))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b8930b0..82a9482 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -33,11 +33,11 @@ ;;; Code: (eval-when-compile (require 'subr-x)) -(when (require 'emojify nil :noerror) - (declare-function emojify-insert-emoji "emojify") - (declare-function emojify-set-emoji-data "emojify") - (defvar emojify-emojis-dir) - (defvar emojify-user-emojis)) +(require 'emojify nil :noerror) +(declare-function emojify-insert-emoji "emojify") +(declare-function emojify-set-emoji-data "emojify") +(defvar emojify-emojis-dir) +(defvar emojify-user-emojis) (require 'cl-lib) (require 'persist) @@ -48,43 +48,45 @@ (defvar mastodon-tl--enable-proportional-fonts) (defvar mastodon-profile-account-settings) +(autoload 'iso8601-parse "iso8601") (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-http--get-json-async "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") (autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--get-source-pref "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-profile--update-preference "mastodon-profile") (autoload 'mastodon-search--search-accounts-query "mastodon-search") (autoload 'mastodon-search--search-tags-query "mastodon-search") (autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") +(autoload 'mastodon-tl--do-if-toot-strict "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") +(autoload 'mastodon-tl--map-alist "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") -(autoload 'mastodon-tl--toot-id "mastodon-tl") -(autoload 'mastodon-toot "mastodon") -(autoload 'mastodon-profile--get-source-pref "mastodon-profile") -(autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") (autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--view-scheduled-toots "mastodon-tl") -(autoload 'mastodon-tl--cancel-scheduled-toot "mastodon-toot") +(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-toot "mastodon") +(autoload 'mastodon-views--cancel-scheduled-toot "mastodon-views") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") (autoload 'org-read-date "org") -(autoload 'iso8601-parse "iso8601") -(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") -(autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -98,18 +100,15 @@ (defcustom mastodon-toot--default-media-directory "~/" "The default directory when prompting for a media file to upload." - :group 'mastodon-toot :type 'string) (defcustom mastodon-toot--attachment-height 80 "Height of the attached images preview in the toot draft buffer." - :group 'mastodon-toot :type 'integer) (defcustom mastodon-toot--enable-completion t "Whether to enable completion of mentions and hashtags. Used for completion in toot compose buffer." - :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot--use-company-for-completion nil @@ -119,12 +118,10 @@ buffer, and mastodon completion backends are added to `company-capf'. You need to install company yourself to use this." - :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot--completion-style-for-mentions "all" "The company completion style to use for mentions." - :group 'mastodon-toot :type '(choice (const :tag "off" nil) (const :tag "following only" "following") @@ -132,27 +129,23 @@ You need to install company yourself to use this." (defcustom mastodon-toot-display-orig-in-reply-buffer nil "Display a copy of the toot replied to in the compose buffer." - :group 'mastodon-toot :type 'boolean) (defcustom mastodon-toot-orig-in-reply-length 160 "Length to crop toot replied to in the compose buffer to." - :group 'mastodon-toot :type 'integer) (defcustom mastodon-toot--default-reply-visibility "public" "Default visibility settings when replying. If the original toot visibility is different we use the more restricted one." - :group 'mastodon-toot :type '(choice - (const :tag "public" "public") - (const :tag "unlisted" "unlisted") - (const :tag "followers only" "private") - (const :tag "direct" "direct"))) + (const :tag "public" "public") + (const :tag "unlisted" "unlisted") + (const :tag "followers only" "private") + (const :tag "direct" "direct"))) (defcustom mastodon-toot--enable-custom-instance-emoji nil "Whether to enable your instance's custom emoji by default." - :group 'mastodon-toot :type 'boolean) (defvar-local mastodon-toot--content-warning nil @@ -223,16 +216,16 @@ send.") (defvar mastodon-toot-handle-regex (concat - ;; preceding space or bol [boundary doesn't work with @] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with @] + "\\([(\n\t ]\\|^\\)" "\\(?2:@[1-9a-zA-Z._-]+" ; a handle "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @ "\\b")) (defvar mastodon-toot-tag-regex (concat - ;; preceding space or bol [boundary doesn't work with #] - "\\([\n\t ]\\|^\\)" + ;; preceding bracket, space or bol [boundary doesn't work with #] + "\\([(\n\t ]\\|^\\)" "\\(?2:#[1-9a-zA-Z_]+\\)" ; tag "\\b")) ; boundary @@ -287,14 +280,14 @@ NO-TOOT means we are not calling from a toot buffer." (mastodon-toot--update-status-fields))))) (defun mastodon-toot--action-success (marker byline-region remove) - "Insert/remove the text MARKER with 'success face in byline. + "Insert/remove the text MARKER with `success' face in byline. BYLINE-REGION is a cons of start and end pos of the byline to be modified. Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((inhibit-read-only t) (bol (car byline-region)) (eol (cdr byline-region)) - (at-byline-p (eq (get-text-property (point) 'byline) t))) + (at-byline-p (eq (mastodon-tl--property 'byline :no-move) t))) (save-excursion (when remove (goto-char bol) @@ -329,59 +322,90 @@ boosting, or bookmarking toots." (defun mastodon-toot--toggle-boost-or-favourite (type) "Toggle boost or favourite of toot at `point'. -TYPE is a symbol, either 'favourite or 'boost." +TYPE is a symbol, either `favourite' or `boost.'" (interactive) - (let* ((boost-p (equal type 'boost)) - (has-id (mastodon-tl--property 'base-toot-id)) - (byline-region (when has-id - (mastodon-tl--find-property-range 'byline (point)))) - (id (when byline-region - (mastodon-tl--as-string (mastodon-tl--property 'base-toot-id)))) - (boosted (when byline-region - (get-text-property (car byline-region) 'boosted-p))) - (faved (when byline-region - (get-text-property (car byline-region) 'favourited-p))) - (action (if boost-p - (if boosted "unreblog" "reblog") - (if faved "unfavourite" "favourite"))) - (msg (if boosted "unboosted" "boosted")) - (action-string (if boost-p "boost" "favourite")) - (remove (if boost-p (when boosted t) (when faved t))) - (toot-type (alist-get 'type (mastodon-tl--property 'toot-json))) - (visibility (mastodon-tl--field 'visibility - (mastodon-tl--property 'toot-json)))) - (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)) - ;; & nothing wrong with faving/boosting own toots from notifs: - ;; this boosts/faves the base toot, not the notif status - ((and (equal "reblog" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (error "You can't %s boosts" action-string)) - ((and (equal "favourite" toot-type) - (not (mastodon-tl--buffer-type-eq 'notifications))) - (error "You can't %s favourites" action-string)) - ((and (equal "private" visibility) - (equal type 'boost)) - (error "You can't boost private toots")) - (t - (mastodon-toot--action - action - (lambda () - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--action-success - (if boost-p - (mastodon-tl--symbol 'boost) - (mastodon-tl--symbol 'favourite)) - byline-region remove)) - (message (format "%s #%s" (if boost-p msg action) id)))))) - (message (format "Nothing to %s here?!?" action-string))))) + (mastodon-tl--do-if-toot-strict + (let* ((boost-p (equal type 'boost)) + (has-id (mastodon-tl--property 'base-toot-id)) + (byline-region (when has-id + (mastodon-tl--find-property-range 'byline (point)))) + (id (when byline-region + (mastodon-tl--as-string (mastodon-tl--property 'base-toot-id)))) + (boosted (when byline-region + (get-text-property (car byline-region) 'boosted-p))) + (faved (when byline-region + (get-text-property (car byline-region) 'favourited-p))) + (action (if boost-p + (if boosted "unreblog" "reblog") + (if faved "unfavourite" "favourite"))) + (msg (if boosted "unboosted" "boosted")) + (action-string (if boost-p "boost" "favourite")) + (remove (if boost-p (when boosted t) (when faved t))) + (toot-type (alist-get 'type (mastodon-tl--property 'toot-json))) + (visibility (mastodon-tl--field 'visibility + (mastodon-tl--property 'toot-json)))) + (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)) + ;; & nothing wrong with faving/boosting own toots from notifs: + ;; this boosts/faves the base toot, not the notif status + ((and (equal "reblog" toot-type) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (error "You can't %s boosts" action-string)) + ((and (equal "favourite" toot-type) + (not (mastodon-tl--buffer-type-eq 'notifications))) + (error "You can't %s favourites" action-string)) + ((and (equal "private" visibility) + (equal type 'boost)) + (error "You can't boost private toots")) + (t + (mastodon-toot--action + action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) + (mastodon-toot--update-stats-on-action type remove) + (mastodon-toot--action-success + (if boost-p + (mastodon-tl--symbol 'boost) + (mastodon-tl--symbol 'favourite)) + byline-region remove)) + (message (format "%s #%s" (if boost-p msg action) id)))))) + (message (format "Nothing to %s here?!?" action-string)))))) + +(defun mastodon-toot--inc-or-dec (count subtract) + "If SUBTRACT, decrement COUNT, else increment." + (if subtract + (1- count) + (1+ count))) + +(defun mastodon-toot--update-stats-on-action (action &optional subtract) + "Increment the toot stats display upon ACTION. +ACTION is a symbol, either `favourite' or `boost'. +SUBTRACT means we are un-favouriting or unboosting, so we decrement." + (let* ((count-prop (if (eq action 'favourite) + 'favourites-count + 'boosts-count)) + (count-prop-range (mastodon-tl--find-property-range count-prop (point))) + (count (get-text-property (car count-prop-range) count-prop)) + (inhibit-read-only 1)) + ;; TODO another way to implement this would be to async fetch counts again + ;; and re-display from count-properties + (add-text-properties + (car count-prop-range) + (cdr count-prop-range) + (list 'display ; update the display prop: + (number-to-string + (mastodon-toot--inc-or-dec count subtract)) + ;; update the count prop + ;; we rely on this for any subsequent actions: + count-prop + (mastodon-toot--inc-or-dec count subtract))))) (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." @@ -394,39 +418,40 @@ TYPE is a symbol, either 'favourite or 'boost." (mastodon-toot--toggle-boost-or-favourite 'favourite)) ;; TODO maybe refactor into boost/fave fun -(defun mastodon-toot--bookmark-toot-toggle () +(defun mastodon-toot--toggle-bookmark () "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 (mastodon-tl--symbol 'bookmark)) - (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 - action - (lambda () - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (list 'bookmarked-p (not bookmarked-p)))) - (mastodon-toot--action-success - bookmark-str - byline-region remove) - (message (format "%s #%s" message id))))) - (message (format "Nothing to %s here?!?" action))))) + (mastodon-tl--do-if-toot-strict + (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 (mastodon-tl--symbol 'bookmark)) + (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 + action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p)))) + (mastodon-toot--action-success + bookmark-str + byline-region remove) + (message (format "%s #%s" message id))))) + (message (format "Nothing to %s here?!?" action)))))) (defun mastodon-toot--list-toot-boosters () "List the boosters of toot at point." @@ -441,26 +466,27 @@ TYPE is a symbol, either 'favourite or 'boost." (defun mastodon-toot--list-toot-boosters-or-favers (&optional favourite) "List the favouriters or boosters of toot at point. With FAVOURITE, list favouriters, else list boosters." - (let* ((base-toot (mastodon-tl--property 'base-toot-id)) - (endpoint (if favourite "favourited_by" "reblogged_by")) - (url (mastodon-http--api - (format "statuses/%s/%s" base-toot endpoint))) - (params '(("limit" . "80"))) - (json (mastodon-http--get-json url params))) - (if (eq (caar json) 'error) - (error "%s (Status does not exist or is private)" - (alist-get 'error json)) - (let ((handles (mapcar (lambda (x) (alist-get 'acct x)) json)) - (type-string (if favourite "Favouriters" "Boosters"))) - (if (not handles) - (error "Looks like this toot has no %s" type-string) - (let ((choice - (completing-read - (format "%s (enter to view profile): " type-string) - handles - nil - t))) - (mastodon-profile--show-user choice))))))) + (mastodon-tl--do-if-toot-strict + (let* ((base-toot (mastodon-tl--property 'base-toot-id)) + (endpoint (if favourite "favourited_by" "reblogged_by")) + (url (mastodon-http--api + (format "statuses/%s/%s" base-toot endpoint))) + (params '(("limit" . "80"))) + (json (mastodon-http--get-json url params))) + (if (eq (caar json) 'error) + (error "%s (Status does not exist or is private)" + (alist-get 'error json)) + (let ((handles (mastodon-tl--map-alist 'acct json)) + (type-string (if favourite "Favouriters" "Boosters"))) + (if (not handles) + (error "Looks like this toot has no %s" type-string) + (let ((choice + (completing-read + (format "%s (enter to view profile): " type-string) + handles + nil + t))) + (mastodon-profile--show-user choice)))))))) (defun mastodon-toot--copy-toot-url () "Copy URL of toot at point. @@ -520,12 +546,12 @@ Uses `lingva.el'." (msg-y-or-n (if pinned-p "Unpin" "Pin"))) (if (not pinnable-p) (message "You can only pin your own toots.") - (if (y-or-n-p (format "%s this toot? " msg-y-or-n)) - (mastodon-toot--action action - (lambda () - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot %s!" msg))))))) + (when (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (mastodon-toot--action action + (lambda () + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot %s!" msg))))))) (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." @@ -546,22 +572,22 @@ NO-REDRAFT means delete toot only." (reply-id (alist-get 'in_reply_to_id toot))) (if (not (mastodon-toot--own-toot-p toot)) (message "You can only delete (and redraft) your own toots.") - (if (y-or-n-p (if no-redraft - (format "Delete this toot? ") - (format "Delete and redraft this toot? "))) - (let* ((response (mastodon-http--delete url))) - (mastodon-http--triage - response - (lambda () - (if no-redraft - (progn - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot deleted!")) - (mastodon-toot--redraft response - reply-id - toot-visibility - toot-cw))))))))) + (when (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) + (let* ((response (mastodon-http--delete url))) + (mastodon-http--triage + response + (lambda () + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + reply-id + toot-visibility + toot-cw))))))))) (defun mastodon-toot--set-cw (&optional cw) "Set content warning to CW if it is non-nil." @@ -727,16 +753,6 @@ to `emojify-user-emojis', and the emoji data is updated." (point-min)))) (buffer-substring (cdr header-region) (point-max)))) -(defun mastodon-toot--set-visibility (visibility) - "Set the visiblity of the next toot to VISIBILITY." - (interactive - (list (completing-read "Visiblity: " '("public" - "unlisted" - "private" - "direct")))) - (setq mastodon-toot--visibility visibility) - (message "Visibility set to %s" visibility)) - (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append @@ -815,7 +831,7 @@ instance to edit a toot." (message "Toot toot!")) ;; cancel scheduled toot if we were editing it: (when scheduled-id - (mastodon-tl--cancel-scheduled-toot + (mastodon-views--cancel-scheduled-toot scheduled-id :no-confirm)) (mastodon-toot--restore-previous-window-config prev-window-config)))))))) @@ -870,7 +886,7 @@ instance to edit a toot." (insert (propertize (if (= count 1) (format "%s [original]:\n" count) (format "%s:\n" count)) - 'face 'font-lock-comment-face) + 'face font-lock-comment-face) (mastodon-toot--insert-toot-iter x) "\n") (cl-incf count)) @@ -903,9 +919,8 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config." "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. Remove empty string (self) from result and joins the sequence with whitespace." (mapconcat (lambda (mention) mention) - (remove "" (mapcar (lambda (x) (mastodon-toot--process-local x)) - mentions)) - " ")) + (remove "" (mapcar #'mastodon-toot--process-local mentions)) + " ")) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -931,8 +946,7 @@ Federated user: `username@host.co`." (alist-get 'mentions (alist-get 'reblog status)) (alist-get 'mentions status)))) ;; reverse does not work on vectors in 24.5 - (mapcar (lambda(x) (alist-get 'acct x)) - (reverse mentions)))) + (mastodon-tl--map-alist 'acct (reverse mentions)))) (defun mastodon-toot--get-bounds (regex) "Get bounds of tag or handle before point using REGEX." @@ -1018,39 +1032,39 @@ If TAGS, we search for tags, else we search for handles." Customize `mastodon-toot-display-orig-in-reply-buffer' to display text of the toot being replied to in the compose buffer." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - ;; NB: we cannot use mastodon-tl--property for 'base-toot - ;; because if it doesn't have one, it is fetched from next toot! - ;; we also cannot use --field because we need to get a different property first - (base-toot (get-text-property (point) 'base-toot)) ; for new notifs handling - (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) - (account (mastodon-tl--field 'account toot)) - (user (alist-get 'acct account)) - (mentions (mastodon-toot--mentions (or base-toot toot))) - (boosted (mastodon-tl--field 'reblog (or base-toot toot))) - (booster (when boosted - (alist-get 'acct - (alist-get 'account toot))))) - (mastodon-toot (when user - (if booster - (if (and (not (equal user booster)) - (not (member booster mentions))) - ;; different booster, user and mentions: - (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) - ;; booster is either user or in mentions: - (if (not (member user mentions)) - ;; user not already in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user already in mentions: - (mastodon-toot--mentions-to-string (copy-sequence mentions)))) - ;; ELSE no booster: - (if (not (member user mentions)) - ;; user not in mentions: - (mastodon-toot--mentions-to-string (append (list user) mentions nil)) - ;; user in mentions already: - (mastodon-toot--mentions-to-string (copy-sequence mentions))))) - id - (or base-toot toot)))) + (mastodon-tl--do-if-toot-strict + (let* ((toot (mastodon-tl--property 'toot-json)) + ;; no-move arg for base toot, because if it doesn't have one, it is + ;; fetched from next toot! + (base-toot (mastodon-tl--property 'base-toot :no-move)) ; for new notifs handling + (id (mastodon-tl--as-string (mastodon-tl--field 'id (or base-toot toot)))) + (account (mastodon-tl--field 'account toot)) + (user (alist-get 'acct account)) + (mentions (mastodon-toot--mentions (or base-toot toot))) + (boosted (mastodon-tl--field 'reblog (or base-toot toot))) + (booster (when boosted + (alist-get 'acct + (alist-get 'account toot))))) + (mastodon-toot (when user + (if booster + (if (and (not (equal user booster)) + (not (member booster mentions))) + ;; different booster, user and mentions: + (mastodon-toot--mentions-to-string (append (list user booster) mentions nil)) + ;; booster is either user or in mentions: + (if (not (member user mentions)) + ;; user not already in mentions: + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + ;; user already in mentions: + (mastodon-toot--mentions-to-string (copy-sequence mentions)))) + ;; ELSE no booster: + (if (not (member user mentions)) + ;; user not in mentions: + (mastodon-toot--mentions-to-string (append (list user) mentions nil)) + ;; user in mentions already: + (mastodon-toot--mentions-to-string (copy-sequence mentions))))) + id + (or base-toot toot))))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." @@ -1070,16 +1084,18 @@ text of the toot being replied to in the compose buffer." (defun mastodon-toot--change-visibility () "Change the current visibility to the next valid value." (interactive) - (setq mastodon-toot--visibility - (cond ((string= mastodon-toot--visibility "public") - "unlisted") - ((string= mastodon-toot--visibility "unlisted") - "private") - ((string= mastodon-toot--visibility "private") - "direct") - (t - "public"))) - (mastodon-toot--update-status-fields)) + (if (mastodon-tl--buffer-type-eq 'edit-toot) + (message "You can't change visibility when editing toots.") + (setq mastodon-toot--visibility + (cond ((string= mastodon-toot--visibility "public") + "unlisted") + ((string= mastodon-toot--visibility "unlisted") + "private") + ((string= mastodon-toot--visibility "private") + "direct") + (t + "public"))) + (mastodon-toot--update-status-fields))) (defun mastodon-toot--clear-all-attachments () "Remove all attachments from a toot draft." @@ -1241,34 +1257,40 @@ With RESCHEDULE, reschedule the scheduled toot at point without editing." ;; original idea by christian tietze, thanks! ;; https://codeberg.org/martianh/mastodon.el/issues/285 (interactive) - (let* ((id (when reschedule (get-text-property (point) 'id))) - (ts (when reschedule - (alist-get 'scheduled_at - (get-text-property (point) 'scheduled-json)))) - (time-value - (org-read-date t t nil "Schedule toot:" - ;; default to scheduled timestamp if already set: - (mastodon-toot--iso-to-org - ;; we are rescheduling without editing: - (or ts - ;; we are maybe editing the scheduled toot: - mastodon-toot--scheduled-for)))) - (iso8601-str (format-time-string "%FT%T%z" time-value)) - (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value))) - (if (not reschedule) - (progn - (setq-local mastodon-toot--scheduled-for iso8601-str) - (message (format "Toot scheduled for %s." msg-str))) - (let* ((args (when reschedule `(("scheduled_at" . ,iso8601-str)))) - (url (when reschedule (mastodon-http--api - (format "scheduled_statuses/%s" id)))) - (response (mastodon-http--put url args))) - (mastodon-http--triage response - (lambda () - ;; reschedule means we are in scheduled toots view: - (mastodon-tl--view-scheduled-toots) - (message - (format "Toot rescheduled for %s." msg-str)))))))) + (cond ((mastodon-tl--buffer-type-eq 'edit-toot) + (message "You can't schedule toots you're editing.")) + ((not (or (mastodon-tl--buffer-type-eq 'new-toot) + (mastodon-tl--buffer-type-eq 'scheduled-statuses))) + (message "You can only schedule toots from the compose toot buffer or the scheduled toots view.")) + (t + (let* ((id (when reschedule (mastodon-tl--property 'id :no-move))) + (ts (when reschedule + (alist-get 'scheduled_at + (mastodon-tl--property 'scheduled-json :no-move)))) + (time-value + (org-read-date t t nil "Schedule toot:" + ;; default to scheduled timestamp if already set: + (mastodon-toot--iso-to-org + ;; we are rescheduling without editing: + (or ts + ;; we are maybe editing the scheduled toot: + mastodon-toot--scheduled-for)))) + (iso8601-str (format-time-string "%FT%T%z" time-value)) + (msg-str (format-time-string "%d-%m-%y at %H:%M[%z]" time-value))) + (if (not reschedule) + (progn + (setq-local mastodon-toot--scheduled-for iso8601-str) + (message (format "Toot scheduled for %s." msg-str))) + (let* ((args (when reschedule `(("scheduled_at" . ,iso8601-str)))) + (url (when reschedule (mastodon-http--api + (format "scheduled_statuses/%s" id)))) + (response (mastodon-http--put url args))) + (mastodon-http--triage response + (lambda () + ;; reschedule means we are in scheduled toots view: + (mastodon-views--view-scheduled-toots) + (message + (format "Toot rescheduled for %s." msg-str)))))))))) (defun mastodon-toot--iso-to-human (ts) "Format an ISO8601 timestamp TS to be more human-readable." @@ -1346,7 +1368,7 @@ LONGEST is the length of the longest binding." (mastodon-toot--format-kbinds kbinds)))) (concat " Compose a new toot here. The following keybindings are available:" - (mapconcat 'identity + (mapconcat #'identity (mastodon-toot--formatted-kbinds-pairs (mastodon-toot--format-kbinds kbinds) longest-kbind) @@ -1387,7 +1409,7 @@ REPLY-TEXT is the text of the toot being replied to." (propertize "None " 'toot-attachments t) "\n") - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'read-only "Edit your message below." 'toot-post-header t) (if reply-text @@ -1399,7 +1421,7 @@ REPLY-TEXT is the text of the toot being replied to." (propertize (concat divider "\n") 'rear-nonsticky t - 'face 'font-lock-comment-face + 'face font-lock-comment-face 'read-only "Edit your message below." 'toot-post-header t)))) @@ -1633,7 +1655,7 @@ EDIT means we are editing an existing toot, not composing a new one." ;; company (when (and mastodon-toot--use-company-for-completion (require 'company nil :no-error)) - (declare-function 'company-mode-on "company") + (declare-function company-mode-on "company") (set (make-local-variable 'company-backends) (add-to-list 'company-backends 'company-capf)) (company-mode-on))) @@ -1661,7 +1683,6 @@ EDIT means we are editing an existing toot, not composing a new one." (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." - :group 'mastodon-toot :keymap mastodon-toot-mode-map :global nil) diff --git a/lisp/mastodon-views.el b/lisp/mastodon-views.el new file mode 100644 index 0000000..22eac7e --- /dev/null +++ b/lisp/mastodon-views.el @@ -0,0 +1,908 @@ +;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 Marty Hiatt +;; Author: Marty Hiatt <martianhiatus@riseup.net> +;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> +;; Version: 1.0.0 +;; Package-Requires: ((emacs "27.1")) +;; Homepage: https://codeberg.org/martianh/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-views.el provides minor views functions. + +;; These are currently lists, follow suggestions, filters, scheduled toots, +;; follow requests, and instance descriptions. + +;; It doesn't include favourites, bookmarks, preferences, trending tags, followed tags, toot edits, + +;;; Code: + +(require 'cl-lib) +(require 'mastodon-http) + +(defvar mastodon-mode-map) + +(autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-tl--init "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") +(autoload 'mastodon-tl--set-face "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") +(autoload 'mastodon-tl--profile-buffer-p "mastodon-tl") +(autoload 'mastodon-tl--goto-next-item "mastodon-tl") +(autoload 'mastodon-tl--goto-prev-item "mastodon-tl") +(autoload 'mastodon-tl--goto-first-item "mastodon-tl") +(autoload 'mastodon-tl--do-if-toot "mastodon-tl") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--render-text "mastodon-tl") +(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-toot--iso-to-human "mastodon-toot") +(autoload 'mastodon-toot--schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--compose-buffer "mastodon-toot") +(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") +(autoload 'mastodon-search--propertize-user "mastodon-search") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-tl--map-alist "mastodon-tl") +(autoload 'mastodon-tl--map-alist-vals-to-alist "mastodon-tl") + + +;;; KEYMAPS + +;; we copy `mastodon-mode-map', as then all timeline functions are +;; available. this is helpful because if a minor view is the only buffer left +;; open, calling `mastodon' will switch to it, but then we will be unable to +;; switch to timlines without closing the minor view. + +;; copying the mode map however means we need to avoid/unbind/override any +;; functions that might cause interfere with the minor view. + +;; this is not redundant, as while the buffer -init function calls +;; `mastodon-mode', it gets overridden in some but not all cases. + +(defvar mastodon-views-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-mode-map) + (define-key map (kbd "n") #'mastodon-tl--goto-next-item) + (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) + map) + "Base keymap for minor mastodon views.") + +(defvar mastodon-views--view-filters-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + (define-key map (kbd "d") #'mastodon-views--delete-filter) + (define-key map (kbd "c") #'mastodon-views--create-filter) + (define-key map (kbd "TAB") #'mastodon-tl--goto-next-item) + (define-key map (kbd "g") #'mastodon-views--view-filters) + map) + "Keymap for viewing filters.") + +(defvar mastodon-views--follow-suggestions-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + (define-key map (kbd "g") #'mastodon-views--view-follow-suggestions) + map) + "Keymap for viewing follow suggestions.") + +(defvar mastodon-views--view-lists-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + (define-key map (kbd "D") #'mastodon-views--delete-list) + (define-key map (kbd "C") #'mastodon-views--create-list) + (define-key map (kbd "A") #'mastodon-views--add-account-to-list) + (define-key map (kbd "R") #'mastodon-views--remove-account-from-list) + (define-key map (kbd "E") #'mastodon-views--edit-list) + (define-key map (kbd "g") #'mastodon-views--view-lists) + map) + "Keymap for viewing lists.") + +(defvar mastodon-views--list-name-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'mastodon-views--view-timeline-list-at-point) + (define-key map (kbd "d") #'mastodon-views--delete-list-at-point) + (define-key map (kbd "a") #'mastodon-views--add-account-to-list-at-point) + (define-key map (kbd "r") #'mastodon-views--remove-account-from-list-at-point) + (define-key map (kbd "e") #'mastodon-views--edit-list-at-point) + map) + "Keymap for when point is on list name.") + +(defvar mastodon-views--scheduled-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + (define-key map (kbd "r") #'mastodon-views--reschedule-toot) + (define-key map (kbd "c") #'mastodon-views--cancel-scheduled-toot) + (define-key map (kbd "e") #'mastodon-views--edit-scheduled-as-new) + (define-key map (kbd "RET") #'mastodon-views--edit-scheduled-as-new) + map) + "Keymap for when point is on a scheduled toot.") + +(defvar mastodon-views--view-follow-requests-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-views-map) + ;; make reject binding match the binding in notifs view + ;; 'r' is then reserved for replying, even tho it is not avail + ;; in foll-reqs view + (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) + (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) + (define-key map (kbd "g") #'mastodon-views--view-follow-requests) + map) + "Keymap for viewing follow requests.") + + +;;; GENERAL FUNCTION + +(defun mastodon-views--minor-view (view-name bindings-string insert-fun data) + "Load a minor view named VIEW-NAME. +BINDINGS-STRING is a string explaining the view's local bindings. +INSERT-FUN is the function to call to insert the view's elements. +DATA is the argument to insert-fun, usually JSON returned in a +request. +This function is used as the update-function to +`mastodon-tl--init-sync', which initializes a buffer for us and +provides the JSON data." + (erase-buffer) + (insert (mastodon-tl--set-face + (concat "\n ------------\n " + (upcase view-name) + "\n" + " ------------\n\n") + 'success) + (if bindings-string + (mastodon-tl--set-face + (concat "[" bindings-string "]" + "\n\n") + 'font-lock-comment-face) + "")) + (if (seq-empty-p data) + (insert (propertize + (format "Looks like you have no %s for now." view-name) + 'face font-lock-comment-face + 'byline t + 'toot-id "0")) ; so point can move here when no filters + (funcall insert-fun data) + (goto-char (point-min))) + ;; (when json + ;; FIXME: this seems to trigger a new request, but ideally would run. + ;; (mastodon-tl--goto-next-toot)))) + ) + + +;;; LISTS + +(defun mastodon-views--view-lists () + "Show the user's lists in a new buffer." + (interactive) + (mastodon-tl--init-sync "lists" + "lists" + 'mastodon-views--insert-lists) + (with-current-buffer "*mastodon-lists*" + (use-local-map mastodon-views--view-lists-keymap))) + +(defun mastodon-views--insert-lists (json) + "Insert the user's lists from JSON." + (mastodon-views--minor-view + "your lists" + "C - create a list\n D - delete a list\ + \n A/R - add/remove account from a list\ + \n E - edit a list\n n/p - go to next/prev item" + #'mastodon-views--print-list-set + json)) + +(defun mastodon-views--print-list-set (lists) + "Print each account plus a separator for each list in LISTS." + (let ((lists-names + (mastodon-tl--map-alist 'title lists))) + (mapc (lambda (x) + (mastodon-views--print-list-accounts x) + (insert (propertize " ------------\n\n" + 'face 'success))) + lists-names))) + +(defun mastodon-views--print-list-accounts (list-name) + "Insert the accounts in list named LIST-NAME." + (let* ((id (mastodon-views--get-list-id list-name)) + (accounts (mastodon-views--accounts-in-list id))) + (insert + (propertize list-name + 'byline t ; so we nav here + 'toot-id "0" ; so we nav here + 'help-echo "RET: view list timeline, d: delete this list, \ +a: add account to this list, r: remove account from this list" + 'list t + 'face 'link + 'keymap mastodon-views--list-name-keymap + 'list-name list-name + 'list-id id) + (propertize + "\n\n" + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name list-name + 'list-id id) + (propertize + (mapconcat #'mastodon-search--propertize-user accounts + " ") + ;; (mastodon-search--insert-users-propertized accounts) + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name list-name + 'list-id id)))) + +(defun mastodon-views--get-users-lists () + "Get the list of the user's lists from the server." + (let ((url (mastodon-http--api "lists"))) + (mastodon-http--get-json url))) + +(defun mastodon-views--get-lists-names () + "Return a list of the user's lists' names." + (let ((lists (mastodon-views--get-users-lists))) + (mastodon-tl--map-alist 'title lists))) + +(defun mastodon-views--get-list-by-name (name) + "Return the list data for list with NAME." + (let* ((lists (mastodon-views--get-users-lists))) + (cl-loop for list in lists + if (string= (alist-get 'title list) name) + return list))) + +(defun mastodon-views--get-list-id (name) + "Return id for list with NAME." + (let ((list (mastodon-views--get-list-by-name name))) + (alist-get 'id list))) + +(defun mastodon-views--get-list-name (id) + "Return name of list with ID." + (let* ((url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--get-json url))) + (alist-get 'title response))) + +(defun mastodon-views--edit-list-at-point () + "Edit list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views--edit-list id))) + +(defun mastodon-views--edit-list (&optional id) + "Prompt for a list and edit the name and replies policy. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (name-old (if id + (mastodon-tl--property 'list-name :no-move) + (completing-read "Edit list: " + list-names))) + (id (or id (mastodon-views--get-list-id name-old))) + (name-choice (read-string "List name: " name-old)) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) + (url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--put url + `(("title" . ,name-choice) + ("replies_policy" . ,replies-policy))))) + (mastodon-http--triage response + (lambda () + (with-current-buffer response + (let* ((json (mastodon-http--process-json)) + (name-new (alist-get 'title json))) + (message "list %s edited to %s!" name-old name-new))) + (when (mastodon-tl--buffer-type-eq 'lists) + (mastodon-views--view-lists)))))) + +(defun mastodon-views--view-timeline-list-at-point () + "View timeline of list at point." + (interactive) + (let ((list-id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views--view-list-timeline list-id))) + +(defun mastodon-views--view-list-timeline (&optional id) + "Prompt for a list and view its timeline. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (list-name (unless id (completing-read "View list: " list-names))) + (id (or id (mastodon-views--get-list-id list-name))) + (endpoint (format "timelines/list/%s" id)) + (name (mastodon-views--get-list-name id)) + (buffer-name (format "list-%s" name))) + (mastodon-tl--init buffer-name endpoint 'mastodon-tl--timeline))) + +(defun mastodon-views--create-list () + "Create a new list. +Prompt for name and replies policy." + (interactive) + (let* ((title (read-string "New list name: ")) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) ; default + (response (mastodon-http--post (mastodon-http--api "lists") + `(("title" . ,title) + ("replies_policy" . ,replies-policy)) + nil))) + (mastodon-views--list-action-triage response + (message "list %s created!" title)))) + +(defun mastodon-views--delete-list-at-point () + "Delete list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views--delete-list id))) + +(defun mastodon-views--delete-list (&optional id) + "Prompt for a list and delete it. +If ID is provided, delete that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (name (if id + (mastodon-views--get-list-name id) + (completing-read "Delete list: " + list-names))) + (id (or id (mastodon-views--get-list-id name))) + (url (mastodon-http--api (format "lists/%s" id)))) + (when (y-or-n-p (format "Delete list %s?" name)) + (let ((response (mastodon-http--delete url))) + (mastodon-views--list-action-triage response + (message "list %s deleted!" name)))))) + +(defun mastodon-views--get-users-followings () + "Return the list of followers of the logged in account." + (let* ((id (mastodon-auth--get-account-id)) + (url (mastodon-http--api (format "accounts/%s/following" id)))) + (mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts + +(defun mastodon-views--add-account-to-list-at-point () + "Prompt for account and add to list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views--add-account-to-list id))) + +(defun mastodon-views--add-account-to-list (&optional id account-id handle) + "Prompt for a list and for an account, add account to list. +If ID is provided, use that list. +If ACCOUNT-ID and HANDLE are provided use them rather than prompting." + (interactive) + (let* ((list-prompt (if handle + (format "Add %s to list: " handle) + "Add account to list: ")) + (list-name (if id + (mastodon-tl--property 'list-name :no-move) + (completing-read list-prompt + (mastodon-views--get-lists-names) nil t))) + (list-id (or id (mastodon-views--get-list-id list-name))) + (followings (mastodon-views--get-users-followings)) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id followings)) + (account (or handle (completing-read "Account to add: " + handles nil t))) + (account-id (or account-id (alist-get account handles nil nil 'equal))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (response (mastodon-http--post url + `(("account_ids[]" . ,account-id))))) + (mastodon-views--list-action-triage + response + (message "%s added to list %s!" account list-name)))) + +(defun mastodon-views--add-toot-account-at-point-to-list () + "Prompt for a list, and add the account of the toot at point to it." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (account (mastodon-tl--field 'account toot)) + (account-id (mastodon-tl--field 'id account)) + (handle (mastodon-tl--field 'acct account))) + (mastodon-views--add-account-to-list nil account-id handle))) + +(defun mastodon-views--remove-account-from-list-at-point () + "Prompt for account and remove from list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views--remove-account-from-list id))) + +(defun mastodon-views--remove-account-from-list (&optional id) + "Prompt for a list, select an account and remove from list. +If ID is provided, use that list." + (interactive) + (let* ((list-name (if id + (mastodon-tl--property 'list-name :no-move) + (completing-read "Remove account from list: " + (mastodon-views--get-lists-names) nil t))) + (list-id (or id (mastodon-views--get-list-id list-name))) + (accounts (mastodon-views--accounts-in-list list-id)) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id accounts)) + (account (completing-read "Account to remove: " + handles nil t)) + (account-id (alist-get account handles nil nil 'equal)) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) + (response (mastodon-http--delete url args))) + (mastodon-views--list-action-triage + response + (message "%s removed from list %s!" account list-name)))) + +(defun mastodon-views--list-action-triage (response message) + "Call `mastodon-http--triage' on RESPONSE and display MESSAGE." + (mastodon-http--triage response + (lambda () + (when (mastodon-tl--buffer-type-eq 'lists) + (mastodon-views--view-lists)) + message))) + +(defun mastodon-views--accounts-in-list (list-id) + "Return the JSON of the accounts in list with LIST-ID." + (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) + (mastodon-http--get-json url))) + + +;;; FOLLOW REQUESTS + +(defun mastodon-views--insert-follow-requests (json) + "Insert the user's current follow requests. +JSON is the data returned by the server." + (mastodon-views--minor-view + "follow requests" + "a/r - accept/reject request at point\n n/p - go to next/prev request" + #'mastodon-views--insert-users-propertized-note + json)) + +(defun mastodon-views--view-follow-requests () + "Open a new buffer displaying the user's follow requests." + (interactive) + (mastodon-tl--init-sync "follow-requests" + "follow_requests" + 'mastodon-views--insert-follow-requests) + (mastodon-tl--goto-first-item) + (with-current-buffer "*mastodon-follow-requests*" + (use-local-map mastodon-views--view-follow-requests-keymap))) + + +;;; SCHEDULED TOOTS + +(defun mastodon-views--view-scheduled-toots () + "Show the user's scheduled toots in a new buffer." + (interactive) + (mastodon-tl--init-sync "scheduled-toots" + "scheduled_statuses" + 'mastodon-views--insert-scheduled-toots) + (with-current-buffer "*mastodon-scheduled-toots*" + (use-local-map mastodon-views--scheduled-map))) + +(defun mastodon-views--insert-scheduled-toots (json) + "Insert the user's scheduled toots, from JSON." + (mastodon-views--minor-view + "your scheduled toots" + "n/p - prev/next\n r - reschedule\n e/RET - edit toot\n c - cancel" + #'mastodon-views--insert-scheduled-toots-list + json)) + +(defun mastodon-views--insert-scheduled-toots-list (scheduleds) + "Insert scheduled toots in SCHEDULEDS." + (mapc #'mastodon-views--insert-scheduled-toot scheduleds)) + +(defun mastodon-views--insert-scheduled-toot (toot) + "Insert scheduled TOOT into the buffer." + (let* ((id (alist-get 'id toot)) + (scheduled (alist-get 'scheduled_at toot)) + (params (alist-get 'params toot)) + (text (alist-get 'text params))) + (insert + (propertize (concat text + " | " + (mastodon-toot--iso-to-human scheduled)) + 'byline t ; so we nav here + 'toot-id "0" ; so we nav here + 'face 'font-lock-comment-face + 'keymap mastodon-views--scheduled-map + 'scheduled-json toot + 'id id) + "\n"))) + +(defun mastodon-views--get-scheduled-toots (&optional id) + "Get the user's currently scheduled toots. +If ID, just return that toot." + (let* ((endpoint (if id + (format "scheduled_statuses/%s" id) + "scheduled_statuses")) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url))) + +(defun mastodon-views--reschedule-toot () + "Reschedule the scheduled toot at point." + (interactive) + (let ((id (mastodon-tl--property 'id :no-move))) + (if (null id) + (message "no scheduled toot at point?") + (mastodon-toot--schedule-toot :reschedule)))) + +(defun mastodon-views--copy-scheduled-toot-text () + "Copy the text of the scheduled toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot :no-move)) + (params (alist-get 'params toot)) + (text (alist-get 'text params))) + (kill-new text))) + +(defun mastodon-views--cancel-scheduled-toot (&optional id no-confirm) + "Cancel the scheduled toot at point. +ID is that of the scheduled toot to cancel. +NO-CONFIRM means there is no ask or message, there is only do." + (interactive) + (let ((id (or id (mastodon-tl--property 'id :no-move)))) + (if (null id) + (message "no scheduled toot at point?") + (when (or no-confirm + (y-or-n-p "Cancel scheduled toot?")) + (let* ((url (mastodon-http--api (format "scheduled_statuses/%s" id))) + (response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda () + (mastodon-views--view-scheduled-toots) + (unless no-confirm + (message "Toot cancelled!"))))))))) + +(defun mastodon-views--edit-scheduled-as-new () + "Edit scheduled status as new toot." + (interactive) + (let ((id (mastodon-tl--property 'id :no-move))) + (if (null id) + (message "no scheduled toot at point?") + (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) + (scheduled (alist-get 'scheduled_at toot)) + (params (alist-get 'params toot)) + (text (alist-get 'text params)) + (visibility (alist-get 'visibility params)) + (cw (alist-get 'spoiler_text params)) + (lang (alist-get 'language params)) + ;; (poll (alist-get 'poll params)) + (reply-id (alist-get 'in_reply_to_id params))) + ;; (media (alist-get 'media_attachments toot))) + (mastodon-toot--compose-buffer) + (goto-char (point-max)) + (insert text) + ;; adopt properties from scheduled toot: + (mastodon-toot--set-toot-properties reply-id visibility cw + lang scheduled id))))) + + +;;; FILTERS + +(defun mastodon-views--view-filters () + "View the user's filters in a new buffer." + (interactive) + (mastodon-tl--init-sync "filters" + "filters" + 'mastodon-views--insert-filters) + (with-current-buffer "*mastodon-filters*" + (use-local-map mastodon-views--view-filters-keymap))) + +(defun mastodon-views--insert-filters (json) + "Insert the user's current filters. +JSON is what is returned by by the server." + (mastodon-views--minor-view + "current filters" + "c - create filter\n d - delete filter at point\n n/p - go to next/prev filter" + #'mastodon-views--insert-filter-string-set + json)) + +(defun mastodon-views--insert-filter-string-set (json) + "Insert a filter string plus a blank line. +JSON is the filters data." + (mapc (lambda (x) + (mastodon-views--insert-filter-string x) + (insert "\n\n")) + json)) + +(defun mastodon-views--insert-filter-string (filter) + "Insert a single FILTER." + (let* ((phrase (alist-get 'phrase filter)) + (contexts (alist-get 'context filter)) + (id (alist-get 'id filter)) + (filter-string (concat "- \"" phrase "\" filtered in: " + (mapconcat #'identity contexts ", ")))) + (insert + (propertize filter-string + 'toot-id id ;for goto-next-filter compat + 'phrase phrase + ;;'help-echo "n/p to go to next/prev filter, c to create new filter, d to delete filter at point." + ;;'keymap mastodon-views--view-filters-keymap + 'byline t)))) ;for goto-next-filter compat + +(defun mastodon-views--create-filter () + "Create a filter for a word. +Prompt for a context, must be a list containting at least one of \"home\", +\"notifications\", \"public\", \"thread\"." + (interactive) + (let* ((url (mastodon-http--api "filters")) + (word (read-string + (format "Word(s) to filter (%s): " (or (current-word) "")) + nil nil (or (current-word) ""))) + (contexts + (if (string-empty-p word) + (error "You must select at least one word for a filter") + (completing-read-multiple + "Contexts to filter [TAB for options]: " + '("home" "notifications" "public" "thread") + nil ; no predicate + t))) ; require-match, as context is mandatory + (contexts-processed + (if (equal nil contexts) + (error "You must select at least one context for a filter") + (mapcar (lambda (x) + (cons "context[]" x)) + contexts))) + (response (mastodon-http--post url (push + `("phrase" . ,word) + contexts-processed)))) + (mastodon-http--triage response + (lambda () + (message "Filter created for %s!" word) + ;; reload if we are in filters view: + (when (mastodon-tl--buffer-type-eq 'filters) + (mastodon-views--view-filters)))))) + +(defun mastodon-views--delete-filter () + "Delete filter at point." + (interactive) + (let* ((filter-id (mastodon-tl--property 'toot-id :no-move)) + (phrase (mastodon-tl--property 'phrase :no-move)) + (url (mastodon-http--api + (format "filters/%s" filter-id)))) + (if (null phrase) + (error "No filter at point?") + (when (y-or-n-p (format "Delete filter %s? " phrase))) + (let ((response (mastodon-http--delete url))) + (mastodon-http--triage response (lambda () + (mastodon-views--view-filters) + (message "Filter for \"%s\" deleted!" phrase))))))) + + +;;; FOLLOW SUGGESTIONS + +(defun mastodon-views--view-follow-suggestions () + "Display a buffer of suggested accounts to follow." + (interactive) + (mastodon-tl--init-sync "follow-suggestions" + "suggestions" + 'mastodon-views--insert-follow-suggestions) + (with-current-buffer "*mastodon-follow-suggestions*" + (use-local-map mastodon-views--follow-suggestions-map))) + +(defun mastodon-views--insert-follow-suggestions (json) + "Insert follow suggestions into buffer. +JSON is the data returned by the server." + (mastodon-views--minor-view + "suggested accounts" + nil + #'mastodon-views--insert-users-propertized-note + json)) + +(defun mastodon-views--insert-users-propertized-note (json) + "Insert users list into the buffer, including profile note. +JSON is the users list data." + (mastodon-search--insert-users-propertized json :note)) + + +;;; INSTANCES + +(defun mastodon-views--view-own-instance (&optional brief) + "View details of your own instance. +BRIEF means show fewer details." + (interactive) + (mastodon-views--view-instance-description :user brief)) + +(defun mastodon-views--view-own-instance-brief () + "View brief details of your own instance." + (interactive) + (mastodon-views--view-instance-description :user :brief)) + +(defun mastodon-views--view-instance-description-brief () + "View brief details of the instance the current post's author is on." + (interactive) + (mastodon-views--view-instance-description nil :brief)) + +(defun mastodon-views--view-instance-description (&optional user brief instance) + "View the details of the instance the current post's author is on. +USER means to show the instance details for the logged in user. +BRIEF means to show fewer details. +INSTANCE is an instance domain name." + (interactive) + (if user + (let ((response (mastodon-http--get-json + (mastodon-http--api "instance") + nil ; params + nil ; silent + :vector))) + (mastodon-views--instance-response-fun response brief instance)) + (mastodon-tl--do-if-toot + (let* ((toot (if (mastodon-tl--profile-buffer-p) + ;; we may be on profile itself: + (or (mastodon-tl--property 'profile-json) + ;; or on profile account listings, which use toot-json: + ;; or just toots: + (mastodon-tl--property 'toot-json)) + ;; normal timeline: + (mastodon-tl--property 'toot-json))) + (reblog (alist-get 'reblog toot)) + (account (or (alist-get 'account reblog) + (alist-get 'account toot))) + ;; we can't use --profile-buffer-p as our test here because we may + ;; be looking at toots/boosts/users in a profile buffer + ;; profile-json works as a defacto test for if point is on the + ;; profile details at the top of a profile buffer. + (url (if (mastodon-tl--property 'profile-json) + (alist-get 'url toot) ; profile + (alist-get 'url account))) + (username (if (mastodon-tl--property 'profile-json) + (alist-get 'username toot) ;; profile + (alist-get 'username account))) + (instance (if instance + (concat "https://" instance) + ;; pleroma URL is https://instance.com/users/username + (if (string-suffix-p "users/" (url-basepath url)) + (string-remove-suffix "/users/" + (url-basepath url)) + ;; mastodon: + (string-remove-suffix (concat "/@" username) + url)))) + (response (mastodon-http--get-json + (if user + (mastodon-http--api "instance") + (concat instance "/api/v1/instance")) + nil ; params + nil ; silent + :vector))) + (mastodon-views--instance-response-fun response brief instance))))) + +(defun mastodon-views--instance-response-fun (response brief instance) + "Display instance description RESPONSE in a new buffer. +BRIEF means to show fewer details. +INSTANCE is the instance were are working with." + (when response + (let* ((domain (url-file-nondirectory instance)) + (buf (get-buffer-create + (format "*mastodon-instance-%s*" domain)))) + (with-current-buffer buf + (switch-to-buffer-other-window buf) + (let ((inhibit-read-only t)) + (erase-buffer) + (special-mode) + (when brief + (setq response + (list (assoc 'uri response) + (assoc 'title response) + (assoc 'short_description response) + (assoc 'email response) + (cons 'contact_account + (list + (assoc 'username + (assoc 'contact_account response)))) + (assoc 'rules response) + (assoc 'stats response)))) + (mastodon-views--print-json-keys response) + (mastodon-mode) + (mastodon-tl--set-buffer-spec (buffer-name buf) + "instance" + nil) + (goto-char (point-min))))))) + +(defun mastodon-views--format-key (el pad) + "Format a key of element EL, a cons, with PAD padding." + (format (concat "%-" + (number-to-string pad) + "s: ") + (propertize + (prin1-to-string (car el)) + 'face '(:underline t)))) + +(defun mastodon-views--print-json-keys (response &optional ind) + "Print the JSON keys and values in RESPONSE. +IND is the optional indentation level to print at." + (let* ((cars (mapcar + (lambda (x) (symbol-name (car x))) + response)) + (pad (1+ (cl-reduce #'max (mapcar #'length cars))))) + (while response + (let ((el (pop response))) + (cond + ;; vector of alists (fields, instance rules): + ((and (vectorp (cdr el)) + (not (seq-empty-p (cdr el))) + (consp (seq-elt (cdr el) 0))) + (insert + (mastodon-views--format-key el pad) + "\n\n") + (seq-do #'mastodon-views--print-instance-rules-or-fields (cdr el)) + (insert "\n")) + ;; vector of strings (media types): + ((and (vectorp (cdr el)) + (not (seq-empty-p (cdr el))) + (< 1 (seq-length (cdr el))) + (stringp (seq-elt (cdr el) 0))) + (when ind (indent-to ind)) + (insert + (mastodon-views--format-key el pad) + "\n" + (seq-mapcat + (lambda (x) (concat x ", ")) + (cdr el) 'string) + "\n\n")) + ;; basic nesting: + ((consp (cdr el)) + (when ind (indent-to ind)) + (insert + (mastodon-views--format-key el pad) + "\n\n") + (mastodon-views--print-json-keys + (cdr el) (if ind (+ ind 4) 4))) + (t + ;; basic handling of raw booleans: + (let ((val (cond ((equal (cdr el) ':json-false) + "no") + ((equal (cdr el) 't) + "yes") + (t + (cdr el))))) + (when ind (indent-to ind)) + (insert (mastodon-views--format-key el pad) + " " + (mastodon-views--newline-if-long (cdr el)) + ;; only send strings straight to --render-text + ;; this makes hyperlinks work: + (if (not (stringp val)) + (mastodon-tl--render-text + (prin1-to-string val)) + (mastodon-tl--render-text val)) + "\n")))))))) + +(defun mastodon-views--print-instance-rules-or-fields (alist) + "Print ALIST of instance rules or contact account or emoji fields." + (let ((key (cond ((alist-get 'id alist) + 'id) + ((alist-get 'name alist) + 'name) + ((alist-get 'shortcode alist) + 'shortcode))) + (value (cond ((alist-get 'id alist) + 'text) + ((alist-get 'value alist) + 'value) + ((alist-get 'url alist) + 'url)))) + (indent-to 4) + (insert + (format "%-5s: " + (propertize (alist-get key alist) + 'face '(:underline t))) + (mastodon-views--newline-if-long (alist-get value alist)) + (format "%s" (mastodon-tl--render-text + (alist-get value alist))) + "\n"))) + +(defun mastodon-views--newline-if-long (el) + "Return a newline string if the cdr of EL is over 50 characters long." + (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) + (if (and (sequencep rend) + (< 50 (length rend))) + "\n" + ""))) + +(provide 'mastodon-views) +;;; mastodon-views.el ends here diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 0c32818..0ac24f7 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -45,61 +45,57 @@ (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") (declare-function request "request") -(autoload 'special-mode "simple") + +(autoload 'mastodon-auth--get-account-name "mastodon-auth") +(autoload 'mastodon-auth--user-acct "mastodon-auth") +(autoload 'mastodon-discover "mastodon-discover") +(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") +(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--my-profile "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") +(autoload 'mastodon-profile--view-bookmarks "mastodon-profile") +(autoload 'mastodon-profile--view-favourites "mastodon-profile") +(autoload 'mastodon-search--search-query "mastodon-search") +(autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-search--trending-tags "mastodon-search") +(autoload 'mastodon-tl--block-user "mastodon-tl") +(autoload 'mastodon-tl--follow-user "mastodon-tl") +(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") (autoload 'mastodon-tl--get-federated-timeline "mastodon-tl") (autoload 'mastodon-tl--get-home-timeline "mastodon-tl") (autoload 'mastodon-tl--get-local-timeline "mastodon-tl") (autoload 'mastodon-tl--get-tag-timeline "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") (autoload 'mastodon-tl--goto-prev-toot "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-tl--list-followed-tags "mastodon-tl") +(autoload 'mastodon-tl--mute-user "mastodon-tl") (autoload 'mastodon-tl--next-tab-item "mastodon-tl") +(autoload 'mastodon-tl--poll-vote "mastodon-http") (autoload 'mastodon-tl--previous-tab-item "mastodon-tl") (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") -(autoload 'mastodon-tl--update "mastodon-tl") -(autoload 'mastodon-profile--get-toot-author "mastodon-profile") -(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") -(autoload 'mastodon-profile--show-user "mastodon-profile") -(autoload 'mastodon-discover "mastodon-discover") -(autoload 'mastodon-tl--block-user "mastodon-tl") (autoload 'mastodon-tl--unblock-user "mastodon-tl") -(autoload 'mastodon-tl--mute-user "mastodon-tl") -(autoload 'mastodon-tl--unmute-user "mastodon-tl") -(autoload 'mastodon-tl--follow-user "mastodon-tl") (autoload 'mastodon-tl--unfollow-user "mastodon-tl") -(autoload 'mastodon-profile--my-profile "mastodon-profile") -(autoload 'mastodon-profile--view-favourites "mastodon-profile") -(autoload 'mastodon-profile--view-follow-requests "mastodon-profile") -(autoload 'mastodon-notifications--follow-request-accept "mastodon-notifications") -(autoload 'mastodon-notifications--follow-request-reject "mastodon-notifications") -(autoload 'mastodon-search--search-query "mastodon-search") -(autoload 'mastodon-auth--get-account-name "mastodon-auth") -;; (autoload 'mastodon-async--stream-federated "mastodon-async") -;; (autoload 'mastodon-async--stream-local "mastodon-async") -;; (autoload 'mastodon-async--stream-home "mastodon-async") -;; (autoload 'mastodon-async--stream-notifications "mastodon-async") -;; (autoload 'mastodon-async-mode "mastodon-async") -(autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") -(autoload 'mastodon-auth--user-acct "mastodon-auth") -(autoload 'mastodon-tl--poll-vote "mastodon-http") -(autoload 'mastodon-profile--view-bookmarks "mastodon-profile") -(autoload 'mastoton-tl--view-filters "mastodon-tl") -(autoload 'mastodon-tl--view-filters "mastodon-tl") -(autoload 'mastodon-tl--get-follow-suggestions "mastodon-tl") +(autoload 'mastodon-tl--unmute-user "mastodon-tl") +(autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (when (require 'lingva nil :no-error) (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) -(autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-profile-account-settings "mastodon-profile") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") -(autoload 'mastodon-notifications--get-mentions "mastodon-notifications") -(autoload 'mastodon-tl--view-lists "mastodon-tl") -(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot") (autoload 'mastodon-toot--view-toot-history "mastodon-tl") -(autoload 'mastodon-tl--init-sync "mastodon-tl") -(autoload 'mastodon-notifications--timeline "mastodon-notifications") -(autoload 'mastodon-search--trending-tags "mastodon-search") -(autoload 'mastodon-tl--view-instance-description "mastodon-tl") -(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") +(autoload 'mastodon-views--view-follow-suggestions "mastodon-views") +(autoload 'mastodon-views--view-filters "mastodon-views") +(autoload 'mastodon-views--view-follow-requests "mastodon-views") +(autoload 'mastodon-views--view-instance-description "mastodon-views") +(autoload 'mastodon-views--view-lists "mastodon-views") +(autoload 'mastodon-views--view-scheduled-toots "mastodon-views") +(autoload 'special-mode "simple") (defvar mastodon-notifications--map) @@ -120,7 +116,6 @@ be \"example_user\". After setting these variables you should restart Emacs for these changes to take effect." - :group 'mastodon :type 'string) (defcustom mastodon-active-user nil @@ -135,7 +130,6 @@ should be \"https://social.instance.org\". After setting these variables you should restart Emacs for these changes to take effect." - :group 'mastodon :type 'string) (defcustom mastodon-toot-timestamp-format "%F %T" @@ -143,7 +137,6 @@ changes to take effect." For valid formatting options see `format-time-string`. The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS. Use. e.g. \"%c\" for your locale's date and time format." - :group 'mastodon :type 'string) (defvar mastodon-mode-map @@ -157,64 +150,67 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map [backtab] #'mastodon-tl--previous-tab-item) (define-key map [?\S-\t] #'mastodon-tl--previous-tab-item) (define-key map [?\M-\t] #'mastodon-tl--previous-tab-item) + (define-key map (kbd "l") #'recenter-top-bottom) ;; navigation between timelines (define-key map (kbd "#") #'mastodon-tl--get-tag-timeline) + (define-key map (kbd ":") #'mastodon-tl--list-followed-tags) (define-key map (kbd "A") #'mastodon-profile--get-toot-author) (define-key map (kbd "F") #'mastodon-tl--get-federated-timeline) (define-key map (kbd "H") #'mastodon-tl--get-home-timeline) (define-key map (kbd "L") #'mastodon-tl--get-local-timeline) (define-key map (kbd "N") #'mastodon-notifications-get) + (define-key map (kbd "@") #'mastodon-notifications--get-mentions) (define-key map (kbd "P") #'mastodon-profile--show-user) - (define-key map (kbd "T") #'mastodon-tl--thread) - ;; navigation out of mastodon + (define-key map (kbd "s") #'mastodon-search--search-query) + (define-key map (kbd "/") #'mastodon-switch-to-buffer) + ;; quitting mastodon (define-key map (kbd "q") #'kill-current-buffer) (define-key map (kbd "Q") #'kill-buffer-and-window) - ;; timeline actions - (define-key map (kbd "b") #'mastodon-toot--toggle-boost) + (define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers) + ;; toot actions (define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot) + (define-key map (kbd "b") #'mastodon-toot--toggle-boost) (define-key map (kbd "f") #'mastodon-toot--toggle-favourite) + (define-key map (kbd "k") #'mastodon-toot--toggle-bookmark) (define-key map (kbd "r") #'mastodon-toot--reply) - ;; this is now duplicated by 'g', cd remove/use for else: - (define-key map (kbd "u") #'mastodon-tl--update) - ;; new toot - (define-key map (kbd "t") #'mastodon-toot) + (define-key map (kbd "C") #'mastodon-toot--copy-toot-url) + (define-key map (kbd "v") #'mastodon-tl--poll-vote) + (define-key map (kbd "E") #'mastodon-toot--view-toot-edits) + (define-key map (kbd "T") #'mastodon-tl--thread) + (when (require 'lingva nil :no-error) + (define-key map (kbd "a") #'mastodon-toot--translate-toot-text)) + (define-key map (kbd ",") #'mastodon-toot--list-toot-favouriters) + (define-key map (kbd ".") #'mastodon-toot--list-toot-boosters) + (define-key map (kbd ";") #'mastodon-views--view-instance-description) ;; override special mode binding (define-key map (kbd "g") #'undefined) (define-key map (kbd "g") #'mastodon-tl--update) - ;; mousebot additions + ;; this is now duplicated by 'g', cd remove/use for else: + (define-key map (kbd "u") #'mastodon-tl--update) + ;; own toot actions: + (define-key map (kbd "t") #'mastodon-toot) + (define-key map (kbd "d") #'mastodon-toot--delete-toot) + (define-key map (kbd "D") #'mastodon-toot--delete-and-redraft-toot) + (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) + (define-key map (kbd "e") #'mastodon-toot--edit-toot-at-point) + ;; user actions (define-key map (kbd "W") #'mastodon-tl--follow-user) (define-key map (kbd "C-S-W") #'mastodon-tl--unfollow-user) (define-key map (kbd "B") #'mastodon-tl--block-user) (define-key map (kbd "C-S-B") #'mastodon-tl--unblock-user) (define-key map (kbd "M") #'mastodon-tl--mute-user) (define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user) + ;; own profile (define-key map (kbd "O") #'mastodon-profile--my-profile) - (define-key map (kbd "S") #'mastodon-search--search-query) - (define-key map (kbd "d") #'mastodon-toot--delete-toot) - (define-key map (kbd "D") #'mastodon-toot--delete-and-redraft-toot) - (define-key map (kbd "C") #'mastodon-toot--copy-toot-url) - (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) - (define-key map (kbd "V") #'mastodon-profile--view-favourites) - (define-key map (kbd "R") #'mastodon-profile--view-follow-requests) (define-key map (kbd "U") #'mastodon-profile--update-user-profile-note) - (define-key map (kbd "v") #'mastodon-tl--poll-vote) - (define-key map (kbd "k") #'mastodon-toot--bookmark-toot-toggle) + (define-key map (kbd "V") #'mastodon-profile--view-favourites) (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) - (define-key map (kbd "I") #'mastodon-tl--view-filters) - (define-key map (kbd "G") #'mastodon-tl--get-follow-suggestions) - (define-key map (kbd "X") #'mastodon-tl--view-lists) - (define-key map (kbd "@") #'mastodon-notifications--get-mentions) - (define-key map (kbd "e") #'mastodon-toot--edit-toot-at-point) - (define-key map (kbd "E") #'mastodon-toot--view-toot-edits) - (define-key map (kbd "l") #'recenter-top-bottom) - (when (require 'lingva nil :no-error) - (define-key map (kbd "a") #'mastodon-toot--translate-toot-text)) - (define-key map (kbd "s") #'mastodon-tl--view-scheduled-toots) - (define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers) - (define-key map (kbd ";") #'mastodon-tl--view-instance-description) - (define-key map (kbd ":") #'mastodon-tl--list-followed-tags) - (define-key map (kbd ",") #'mastodon-toot--list-toot-favouriters) - (define-key map (kbd ".") #'mastodon-toot--list-toot-boosters) + ;; minor views + (define-key map (kbd "R") #'mastodon-views--view-follow-requests) + (define-key map (kbd "S") #'mastodon-views--view-scheduled-toots) + (define-key map (kbd "I") #'mastodon-views--view-filters) + (define-key map (kbd "G") #'mastodon-views--view-follow-suggestions) + (define-key map (kbd "X") #'mastodon-views--view-lists) map) "Keymap for `mastodon-mode'.") @@ -311,7 +307,7 @@ not, just browse the URL in the normal fashion." (interactive) (let* ((query (or query-url (thing-at-point-url-at-point) - (get-text-property (point) 'shr-url) + (mastodon-tl--property 'shr-url :no-move) (read-string "Lookup URL: ")))) (if (not (mastodon--masto-url-p query)) ;; this doesn't work as shr-browse-url doesn't take a url arg @@ -348,7 +344,7 @@ not, just browse the URL in the normal fashion." (save-match-data (or (string-match "^/@[^/]+$" query) (string-match "^/@[^/]+/[[:digit:]]+$" query) - (string-match "^/users/[[:alnum:]]+$" query) + (string-match "^/user[s]?/[[:alnum:]]+$" query) (string-match "^/notice/[[:alnum:]]+$" query) (string-match "^/objects/[-a-f0-9]+$" query) (string-match "^/notes/[a-z0-9]+$" query) @@ -376,9 +372,7 @@ Calls `mastodon-tl--get-buffer-type', which see." "Switch to a live mastodon buffer." (interactive) (let* ((bufs (mastodon-live-buffers)) - (buf-names (mapcar (lambda (buf) - (buffer-name buf)) - bufs)) + (buf-names (mapcar #'buffer-name bufs)) (choice (completing-read "Switch to mastodon buffer: " buf-names))) (switch-to-buffer choice))) diff --git a/mastodon.info b/mastodon.info new file mode 100644 index 0000000..3744169 --- /dev/null +++ b/mastodon.info @@ -0,0 +1,661 @@ +This is mastodon.info, produced by makeinfo version 6.7 from +mastodon.texi. + +INFO-DIR-SECTION Emacs +START-INFO-DIR-ENTRY +* Mastodon: (mastodon). Client for Mastodon on ActivityPub networks. +END-INFO-DIR-ENTRY + + +File: mastodon.info, Node: Top, Next: README, Up: (dir) + +* Menu: + +* README:: + +— The Detailed Node Listing — + +README + +* Installation:: +* Usage:: +* Dependencies:: +* Network compatibility:: +* Contributing:: +* Supporting ‘mastodon.el’: Supporting mastodonel. +* Contributors:: + +Installation + +* MELPA:: +* Emoji:: +* Discover:: + +Usage + +* Logging in to your instance:: +* Timelines:: +* Composing toots:: +* Other commands and account settings:: +* Customization:: +* Alternative timeline layout:: +* Live-updating timelines mastodon-async-mode:: +* Translating toots:: +* bookmarks and ‘mastodon.el’: bookmarks and mastodonel. + +Contributing + +* Bug reports:: +* Fixes and features:: +* Coding style:: + + + +File: mastodon.info, Node: README, Prev: Top, Up: Top + +1 README +******** + +‘mastodon.el’ is an Emacs client for the AcitivityPub social networks +that implement the Mastodon API. For info see +<https://joinmastodon.org/>. + +* Menu: + +* Installation:: +* Usage:: +* Dependencies:: +* Network compatibility:: +* Contributing:: +* Supporting ‘mastodon.el’: Supporting mastodonel. +* Contributors:: + + +File: mastodon.info, Node: Installation, Next: Usage, Up: README + +1.1 Installation +================ + +Clone this repository and add the lisp directory to your load path. +Then, require it and go. + + (add-to-list 'load-path "/path/to/mastodon.el/lisp") + (require 'mastodon) + + Or, with ‘use-package’: + + (use-package mastodon + :ensure t) + + The minimum Emacs version is now 27.1. But if you are running an +older version it shouldn’t be very hard to get it working. + +* Menu: + +* MELPA:: +* Emoji:: +* Discover:: + + +File: mastodon.info, Node: MELPA, Next: Emoji, Up: Installation + +1.1.1 MELPA +----------- + +Add ‘MELPA’ to your archives: + + (require 'package) + (add-to-list 'package-archives + '("melpa" . "http://melpa.org/packages/") t) + + Update and install: + + ‘M-x package-refresh-contents RET’ + + ‘M-x package-install RET mastodon RET’ + + +File: mastodon.info, Node: Emoji, Next: Discover, Prev: MELPA, Up: Installation + +1.1.2 Emoji +----------- + +‘mastodon-mode’ will enable Emojify +(https://github.com/iqbalansari/emacs-emojify) if it is loaded in your +Emacs environment, so there’s no need to write your own hook anymore. +‘emojify-mode’ is not required. + + +File: mastodon.info, Node: Discover, Prev: Emoji, Up: Installation + +1.1.3 Discover +-------------- + +‘mastodon-mode’ can provide a context menu for its keybindings if +Discover (https://github.com/mickeynp/discover.el) is installed. It is +not required. + + if you have Discover, add the following to your Emacs init +configuration: + + (require 'mastodon-discover) + (with-eval-after-load 'mastodon (mastodon-discover)) + + Or, with ‘use-package’: + + (use-package mastodon + :ensure t + :config + (mastodon-discover)) + + +File: mastodon.info, Node: Usage, Next: Dependencies, Prev: Installation, Up: README + +1.2 Usage +========= + +* Menu: + +* Logging in to your instance:: +* Timelines:: +* Composing toots:: +* Other commands and account settings:: +* Customization:: +* Alternative timeline layout:: +* Live-updating timelines mastodon-async-mode:: +* Translating toots:: +* bookmarks and ‘mastodon.el’: bookmarks and mastodonel. + + +File: mastodon.info, Node: Logging in to your instance, Next: Timelines, Up: Usage + +1.2.1 Logging in to your instance +--------------------------------- + +You need to set 2 variables in your init file to get started: + + 1. ‘mastodon-instance-url’ + 2. ‘mastodon-active-user’ + + (see their doc strings for details). For example If you want to post +toots as "example_user@social.instance.org", then put this in your init +file: + + (setq mastodon-instance-url "https://social.instance.org" + mastodon-active-user "example_user") + + Then *restart* Emacs and run ‘M-x mastodon’. Make sure you are +connected to internet before you do this. If you have multiple mastodon +accounts you can activate one at a time by changing those two variables +and restarting Emacs. + + If you were using mastodon.el before 2FA was implemented and the +above steps do not work, delete the old file specified by +‘mastodon-client--token-file’ and restart Emacs and follow the steps +again. + + +File: mastodon.info, Node: Timelines, Next: Composing toots, Prev: Logging in to your instance, Up: Usage + +1.2.2 Timelines +--------------- + +‘M-x mastodon’ + + Opens a ‘*mastodon-home*’ buffer in the major mode and displays +toots. If your credentials are not yet saved, you will be prompted for +email and password. The app registration process will take place if +your ‘mastodon-token-file’ does not contain ‘:client_id’ and +‘:client_secret’. + + 1. Keybindings + + Key Action + ----------------------------------------------------------------------------------------------------- + *Help* + ‘?’ Show discover menu of all bindings, if ‘discover’ is available + *Timeline actions* + ‘n’ Go to next item (toot, notification) + ‘p’ Go to previous item (toot, notification) + ‘M-n=/=<tab>’ Go to the next interesting thing that has an action + ‘M-p=/=<S-tab>’ Go to the previous interesting thing that has an action + ‘F’ Open federated timeline + ‘H’ Open home timeline + ‘L’ Open local timeline + ‘N’ Open notifications timeline + ‘@’ Open mentions-only notifications timeline + ‘u’ Update current timeline + ‘T’ Open thread for toot at point + ‘#’ Prompt for tag and open its timeline + ‘A’ Open author profile of toot at point + ‘P’ Open profile of user attached to toot at point + ‘O’ View own profile + ‘U’ update your profile bio note + ‘;’ view instance description for toot at point + ‘,’ view favouriters of toot at point + ‘.’ view boosters of toot at point + *Other views* + ‘S’ search (posts, users, tags) (NB: only posts you have interacted with) + ‘I’, ‘c’, ‘d’ view, create, and delete filters + ‘R’, ‘a’, ‘j’ view/accept/reject follow requests + ‘G’ view follow suggestions + ‘V’ view your favourited toots + ‘K’ view bookmarked toots + ‘X’ view/edit/create/delete lists + ‘s’ view your scheduled toots + *Toot actions* + ‘t’ Compose a new toot + ‘c’ Toggle content warning content + ‘b’ Boost toot under ‘point’ + ‘f’ Favourite toot under ‘point’ + ‘k’ toggle bookmark of toot at point + ‘r’ Reply to toot under ‘point’ + ‘v’ Vote on poll at point + ‘C’ copy url of toot at point + ‘C-RET’ play video/gif at point (requires ‘mpv’) + ‘e’ edit your toot at point + ‘E’ view edits of toot at point + ‘i’ (un)pin your toot at point + ‘d’ delete your toot at point, and reload current timeline + ‘D’ delete and redraft toot at point, preserving reply/CW/visibility + (‘S-C-’) ‘W’, ‘M’, ‘B’ (un)follow, (un)mute, (un)block author of toot at point + *Profile view* + ‘C-c C-c’ cycle between statuses, followers, following, and statuses without boosts + ‘mastodon-profile--account-account-to-list’ (see lists view) + *Notifications view* + ‘a’, ‘j’ accept/reject follow request + ‘C-k’ clear notification at point + see ‘mastodon-notifications--get-*’ functions for filtered views + *Quitting* + ‘q’ Quit mastodon buffer, leave window open + ‘Q’ Quit mastodon buffer and kill window + ‘C-M-q’ Quit and kill all mastodon buffers + + 2. Toot byline legend + + Marker Meaning + -------------------------------------------- + ‘(B)’ I boosted this toot + ‘(F)’ I favourited this toot + ‘(🔖)’ (or I bookmarked this toot + (‘K’)) + + +File: mastodon.info, Node: Composing toots, Next: Other commands and account settings, Prev: Timelines, Up: Usage + +1.2.3 Composing toots +--------------------- + +‘M-x mastodon-toot’ (or ‘t’ from a mastodon.el buffer). + + Pops a new buffer/window in ‘text-mode’ and ‘mastodon-toot’ minor +mode. Enter the contents of your toot here. ‘C-c C-c’ sends the toot. +‘C-c C-k’ cancels. Both actions kill the buffer and window. + + Autocompletion of mentions and tags is provided by +‘completion-at-point-functions’ (capf) backends. +‘mastodon-toot--enable-completion’ is enabled by default. If you want +to enable ‘company-mode’ in the toot compose buffer, set +‘mastodon-toot--use-company-for-completion’ to ‘t’. (‘mastodon.el’ used +to run its own native company backends, but these have been removed in +favour of capfs.) + + Replies preserve visibility status/content warnings, and include +boosters by default. + + Server’s max toot length, and attachment previews, are shown. + + You can download and use your instance’s custom emoji +(‘mastodon-toot--download-custom-emoji’, +‘mastodon-toot--enable-custom-emoji’). + + The compose buffer uses ‘text-mode’ so any configuration you have for +that mode will be enabled. If any of your existing config conflicts +with ‘mastodon-toot’, you can disable it in the +‘mastodon-toot-mode-hook’. For example, the default value of that hook +is as follows: + + (add-hook 'mastodon-toot-mode-hook + (lambda () + (auto-fill-mode -1))) + + 1. Keybindings + + Key Action + ------------------------------------------------- + ‘C-c C-c’ Send toot + ‘C-c C-k’ Cancel toot + ‘C-c C-w’ Add content warning + ‘C-c C-v’ Change toot visibility + ‘C-c C-n’ Add sensitive media/nsfw flag + ‘C-c C-a’ Upload attachment(s) + ‘C-c !’ Remove all attachments + ‘C-c C-e’ Add emoji (if ‘emojify’ installed) + ‘C-c C-p’ Create a poll + ‘C-c C-l’ Set toot language + + 2. Draft toots + + • Compose buffer text is saved as you type, kept in + ‘mastodon-toot-current-toot-text’. + • ‘mastodon-toot--save-draft’: save the current toot as a draft. + • ‘mastodon-toot--open-draft-toot’: Open a compose buffer and + insert one of your draft toots. + • ‘mastodon-toot--delete-draft-toot’: Delete a draft toot. + • ‘mastodon-toot--delete-all-drafts’: Delete all your drafts. + + +File: mastodon.info, Node: Other commands and account settings, Next: Customization, Prev: Composing toots, Up: Usage + +1.2.4 Other commands and account settings: +------------------------------------------ + +In addition to ‘mastodon’, the following three functions are autoloaded +and should work without first loading ‘mastodon.el’: + • ‘mastodon-toot’: Compose new toot + • ‘mastodon-notifications-get’: View all notifications + • ‘mastodon-url-lookup’: Attempt to load a URL in ‘mastodon.el’. URL + may be at point or provided in the minibuffer. + + • ‘mastodon-tl--view-instance-description’: View information about + the instance that the author of the toot at point is on. + • ‘mastodon-tl--view-own-instance’: View information about your own + instance. + • ‘mastodon-search--trending-tags’: View a list of trending hashtags + on your instance. + + • ‘mastodon-tl--add-toot-account-at-point-to-list’: Add the account + of the toot at point to a list. + + • ‘mastodon-tl--dm-user’: Send a direct message to one of the users + at point. + + • ‘mastodon-profile--add-private-note-to-account’: Add a private note + to another user’s account. + • ‘mastodon-profile--view-account-private-note’: View a private note + on a user’s account. + + • ‘mastodon-profile--show-familiar-followers’: Show a list of + “familiar followers” for a given account. Familiar followers are + accounts that you follow, and that follow the account. + + • ‘mastodon-tl--follow-tag’: Follow a tag (works like following a + user) + • ‘mastodon-tl--unfollow-tag’: Unfollow a tag + • ‘mastodon-tl--list-followed-tags’: View a list of tags you’re + following. + + • ‘mastodon-switch-to-buffer’: switch between mastodon buffers. + + • ‘mastodon-profile--update-display-name’: Update the display name + for your account. + • ‘mastodon-profile--update-user-profile-note’: Update your bio note. + • ‘mastodon-profile--update-meta-fields’: Update your metadata + fields. + • ‘mastodon-profile--set-default-toot-visibility’: Set the default + visibility for your toots. + • ‘mastodon-profile--account-locked-toggle’: Toggle the locked status + of your account. Locked accounts have to manually approve follow + requests. + • ‘mastodon-profile--account-discoverable-toggle’: Toggle the + discoverable status of your account. Non-discoverable accounts are + not listed in the profile directory. + • ‘mastodon-profile--account-bot-toggle’: Toggle whether your account + is flagged as a bot. + • ‘mastodon-profile--account-sensitive-toggle’: Toggle whether your + posts are marked as sensitive (nsfw) by default. + + +File: mastodon.info, Node: Customization, Next: Alternative timeline layout, Prev: Other commands and account settings, Up: Usage + +1.2.5 Customization +------------------- + +See ‘M-x customize-group RET mastodon’ to view all customize options. + + • Timeline options: + • Use proportional fonts + • Default number of posts displayed + • Timestamp format + • Relative timestamps + • Display user avatars + • Avatar image height + • Enable image caching + • Hide replies in timelines + • Show toot stats in byline + + • Compose options: + • Completion style for mentions and tags + • Enable custom emoji + • Display toot being replied to + • Set default reply visibility + + +File: mastodon.info, Node: Alternative timeline layout, Next: Live-updating timelines mastodon-async-mode, Prev: Customization, Up: Usage + +1.2.6 Alternative timeline layout +--------------------------------- + +The incomparable Nicholas Rougier has written an alternative timeline +layout for ‘mastodon.el’. + + The repo is at <https://github.com/rougier/mastodon-alt>. + + +File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Alternative timeline layout, Up: Usage + +1.2.7 Live-updating timelines: ‘mastodon-async-mode’ +---------------------------------------------------- + +(code taken from <https://github.com/alexjgriffith/mastodon-future.el>.) + + Works for federated, local, and home timelines and for notifications. +It’s a little touchy, one thing to avoid is trying to load a timeline +more than once at a time. It can go off the rails a bit, but it’s still +pretty cool. The current maintainer of ‘mastodon.el’ is unable to debug +or improve this feature. + + To enable, it, add ‘(require 'mastodon-async)’ to your ‘init.el’. +Then you can view a timeline with one of the commands that begin with +‘mastodon-async--stream-’. + + +File: mastodon.info, Node: Translating toots, Next: bookmarks and mastodonel, Prev: Live-updating timelines mastodon-async-mode, Up: Usage + +1.2.8 Translating toots +----------------------- + +You can translate toots with ‘mastodon-toot--translate-toot-text’ (‘a’ +in a timeline). At the moment this requires lingva.el +(https://codeberg.org/martianh/lingva.el), a little interface I wrote to +<https://lingva.ml>, to be installed to work. + + You could easily modify the simple function to use your Emacs +translator of choice (‘libretrans.el’ , ‘google-translate’, ‘babel’, +‘go-translate’, etc.), you just need to fetch the toot’s content with +‘(mastodon-tl--content toot)’ and pass it to your translator function as +its text argument. Here’s what ‘mastodon-toot--translate-toot-text’ +looks like: + + (defun mastodon-toot--translate-toot-text () + "Translate text of toot at point. + Uses `lingva.el'." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json))) + (if toot + (lingva-translate nil (mastodon-tl--content toot)) + (message "No toot to translate?")))) + + +File: mastodon.info, Node: bookmarks and mastodonel, Prev: Translating toots, Up: Usage + +1.2.9 bookmarks and ‘mastodon.el’ +--------------------------------- + +‘mastodon.el’ doesn’t currently implement its own bookmark record and +handler, which means that emacs bookmarks will not work as is. Until we +implement them, you can get bookmarks going immediately by using +bookmark+.el +(https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el). + + +File: mastodon.info, Node: Dependencies, Next: Network compatibility, Prev: Usage, Up: README + +1.3 Dependencies +================ + +Hard dependencies (should all install with ‘mastodon.el’): + • ‘request’ (for uploading attachments), + <https://github.com/tkf/emacs-request> + • ‘persist’ for storing some settings across sessions + • ‘ts’ for poll relative expiry times + + Optional dependencies: + • ‘emojify’ for inserting and viewing emojis + • ‘mpv’ and ‘mpv.el’ for viewing videos and gifs + • ‘lingva.el’ for translating toots + + +File: mastodon.info, Node: Network compatibility, Next: Contributing, Prev: Dependencies, Up: README + +1.4 Network compatibility +========================= + +‘mastodon.el’ should work with ActivityPub servers that implement the +Mastodon API. + + Apart from Mastodon itself, it is currently known to work with +Pleroma and Gotosocial. If you attempt to use ‘mastodon.el’ with +another server that implements the Mastodon API and run into problems, +feel free to open an issue. + + +File: mastodon.info, Node: Contributing, Next: Supporting mastodonel, Prev: Network compatibility, Up: README + +1.5 Contributing +================ + +PRs, issues, feature requests, and general feedback are very welcome! + +* Menu: + +* Bug reports:: +* Fixes and features:: +* Coding style:: + + +File: mastodon.info, Node: Bug reports, Next: Fixes and features, Up: Contributing + +1.5.1 Bug reports +----------------- + + 1. ‘mastodon.el’ has bugs, as well as lots of room for improvement. + 2. I receive very little feedback, so if I don’t run into the bug it + often doesn’t get fixed. + 3. If you run into something that seems broken, first try running + ‘mastodon.el’ in emacs with no init file (i.e. ‘emacs -q’ + (instructions and code for doing this are here + (https://codeberg.org/martianh/mastodon.el/issues/300)) to see if + it also happens independently of your own config (it probably + does). + 4. Enable debug on error (‘toggle-debug-on-error’), make the bug + happen again, and copy the backtrace that appears. + 5. Open an issue here and explain what is going on. Provide your + emacs version and what kind of server your account is on. + + +File: mastodon.info, Node: Fixes and features, Next: Coding style, Prev: Bug reports, Up: Contributing + +1.5.2 Fixes and features +------------------------ + + 1. Create an issue (https://codeberg.org/martianh/mastodon.el/issues) + detailing what you’d like to do. + 2. Fork the repository and create a branch off of ‘develop’. + 3. Run the tests and ensure that your code doesn’t break any of them. + 4. Create a pull request referencing the issue created in step 1. + + +File: mastodon.info, Node: Coding style, Prev: Fixes and features, Up: Contributing + +1.5.3 Coding style +------------------ + + • This library uses an unconvential double dash (‘--’) between file + namespaces and function names, which contradicts normal Elisp + style. This needs to be respected until the whole library is + changed. + • Use ‘aggressive-indent-mode’ or similar to keep your code indented. + • Single spaces end sentences in docstrings. + • There’s no need for a blank line after the first docstring line + (one is added automatically when documentation is displayed). + + +File: mastodon.info, Node: Supporting mastodonel, Next: Contributors, Prev: Contributing, Up: README + +1.6 Supporting ‘mastodon.el’ +============================ + +If you’d like to support continued development of ‘mastodon.el’, I +accept donations via paypal: paypal.me/martianh +(https://paypal.me/martianh). If you would prefer a different payment +method, write to me at that address and I can provide IBAN or other +details. + + I don’t have a tech worker’s income, so even a small tip would help +out. + + +File: mastodon.info, Node: Contributors, Prev: Supporting mastodonel, Up: README + +1.7 Contributors +================ + +‘mastodon.el’ is the work of a number of people. + + Some significant contributors are: + + • <https://github.com/jdenen> [original author] + • <http://atomized.org> + • <https://alexjgriffith.itch.io> + • <https://github.com/hdurer> + • <https://codeberg.org/Red_Starfish> + + + +Tag Table: +Node: Top210 +Node: README911 +Node: Installation1310 +Node: MELPA1846 +Node: Emoji2214 +Node: Discover2546 +Node: Usage3098 +Node: Logging in to your instance3508 +Node: Timelines4505 +Ref: Keybindings4980 +Ref: Toot byline legend9098 +Node: Composing toots9370 +Ref: Keybindings (1)10947 +Ref: Draft toots11465 +Node: Other commands and account settings11936 +Node: Customization14759 +Node: Alternative timeline layout15545 +Node: Live-updating timelines mastodon-async-mode15922 +Node: Translating toots16758 +Node: bookmarks and mastodonel17930 +Node: Dependencies18400 +Node: Network compatibility18992 +Node: Contributing19478 +Node: Bug reports19767 +Node: Fixes and features20673 +Node: Coding style21156 +Node: Supporting mastodonel21780 +Node: Contributors22302 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/mastodon.texi b/mastodon.texi new file mode 100644 index 0000000..0ede329 --- /dev/null +++ b/mastodon.texi @@ -0,0 +1,741 @@ +\input texinfo @c -*- texinfo -*- +@c %**start of header +@setfilename mastodon.info +@settitle +@documentencoding UTF-8 +@documentlanguage en +@c %**end of header + +@dircategory Emacs +@direntry +* Mastodon: (mastodon). Client for Mastodon on ActivityPub networks. +@end direntry + +@finalout +@titlepage +@title +@end titlepage + +@contents + +@ifnottex +@node Top +@top +@end ifnottex + +@menu +* README:: + +@detailmenu +--- The Detailed Node Listing --- + +README + +* Installation:: +* Usage:: +* Dependencies:: +* Network compatibility:: +* Contributing:: +* Supporting @samp{mastodon.el}: Supporting @samp{mastodonel}. +* Contributors:: + +Installation + +* MELPA:: +* Emoji:: +* Discover:: + +Usage + +* Logging in to your instance:: +* Timelines:: +* Composing toots:: +* Other commands and account settings:: +* Customization:: +* Alternative timeline layout:: +* Live-updating timelines @samp{mastodon-async-mode}:: +* Translating toots:: +* bookmarks and @samp{mastodon.el}: bookmarks and @samp{mastodonel}. + +Contributing + +* Bug reports:: +* Fixes and features:: +* Coding style:: + +@end detailmenu +@end menu + +@node README +@chapter README + +@samp{mastodon.el} is an Emacs client for the AcitivityPub social networks that +implement the Mastodon API@. For info see @uref{https://joinmastodon.org/}. + +@menu +* Installation:: +* Usage:: +* Dependencies:: +* Network compatibility:: +* Contributing:: +* Supporting @samp{mastodon.el}: Supporting @samp{mastodonel}. +* Contributors:: +@end menu + +@node Installation +@section Installation + +Clone this repository and add the lisp directory to your load path. +Then, require it and go. + +@lisp +(add-to-list 'load-path "/path/to/mastodon.el/lisp") +(require 'mastodon) +@end lisp + +Or, with @samp{use-package}: + +@lisp +(use-package mastodon + :ensure t) +@end lisp + +The minimum Emacs version is now 27.1. But if you are running an older version +it shouldn't be very hard to get it working. + +@menu +* MELPA:: +* Emoji:: +* Discover:: +@end menu + +@node MELPA +@subsection MELPA + +Add @samp{MELPA} to your archives: + +@lisp +(require 'package) +(add-to-list 'package-archives + '("melpa" . "http://melpa.org/packages/") t) +@end lisp + +Update and install: + +@samp{M-x package-refresh-contents RET} + +@samp{M-x package-install RET mastodon RET} + +@node Emoji +@subsection Emoji + +@samp{mastodon-mode} will enable @uref{https://github.com/iqbalansari/emacs-emojify, Emojify} if it is loaded in your Emacs environment, so +there's no need to write your own hook anymore. @samp{emojify-mode} is not required. + +@node Discover +@subsection Discover + +@samp{mastodon-mode} can provide a context menu for its keybindings if @uref{https://github.com/mickeynp/discover.el, Discover} is +installed. It is not required. + +if you have Discover, add the following to your Emacs init configuration: + +@lisp +(require 'mastodon-discover) +(with-eval-after-load 'mastodon (mastodon-discover)) +@end lisp + +Or, with @samp{use-package}: + +@lisp +(use-package mastodon + :ensure t + :config + (mastodon-discover)) +@end lisp + +@node Usage +@section Usage + +@menu +* Logging in to your instance:: +* Timelines:: +* Composing toots:: +* Other commands and account settings:: +* Customization:: +* Alternative timeline layout:: +* Live-updating timelines @samp{mastodon-async-mode}:: +* Translating toots:: +* bookmarks and @samp{mastodon.el}: bookmarks and @samp{mastodonel}. +@end menu + +@node Logging in to your instance +@subsection Logging in to your instance + +You need to set 2 variables in your init file to get started: + +@enumerate +@item +@samp{mastodon-instance-url} +@item +@samp{mastodon-active-user} +@end enumerate + +(see their doc strings for details). For example If you want to post +toots as "example@math{_user}@@social.instance.org", then put this in your init +file: + +@lisp +(setq mastodon-instance-url "https://social.instance.org" + mastodon-active-user "example_user") +@end lisp + +Then @strong{restart} Emacs and run @samp{M-x mastodon}. Make sure you are connected +to internet before you do this. If you have multiple mastodon accounts +you can activate one at a time by changing those two variables and +restarting Emacs. + +If you were using mastodon.el before 2FA was implemented and the above steps +do not work, delete the old file specified by @samp{mastodon-client--token-file} and +restart Emacs and follow the steps again. + +@node Timelines +@subsection Timelines + +@samp{M-x mastodon} + +Opens a @samp{*mastodon-home*} buffer in the major mode and displays toots. If your +credentials are not yet saved, you will be prompted for email and password. +The app registration process will take place if your @samp{mastodon-token-file} does +not contain @samp{:client_id} and @samp{:client_secret}. + +@enumerate +@item +@anchor{Keybindings}Keybindings + + +@multitable {aaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Key +@tab Action +@item +@tab @strong{Help} +@item @samp{?} +@tab Show discover menu of all bindings, if @samp{discover} is available +@item +@tab @strong{Timeline actions} +@item @samp{n} +@tab Go to next item (toot, notification) +@item @samp{p} +@tab Go to previous item (toot, notification) +@item @samp{M-n=/=<tab>} +@tab Go to the next interesting thing that has an action +@item @samp{M-p=/=<S-tab>} +@tab Go to the previous interesting thing that has an action +@item @samp{F} +@tab Open federated timeline +@item @samp{H} +@tab Open home timeline +@item @samp{L} +@tab Open local timeline +@item @samp{N} +@tab Open notifications timeline +@item @samp{@@} +@tab Open mentions-only notifications timeline +@item @samp{u} +@tab Update current timeline +@item @samp{T} +@tab Open thread for toot at point +@item @samp{#} +@tab Prompt for tag and open its timeline +@item @samp{A} +@tab Open author profile of toot at point +@item @samp{P} +@tab Open profile of user attached to toot at point +@item @samp{O} +@tab View own profile +@item @samp{U} +@tab update your profile bio note +@item @samp{;} +@tab view instance description for toot at point +@item @samp{,} +@tab view favouriters of toot at point +@item @samp{.} +@tab view boosters of toot at point +@item +@tab @strong{Other views} +@item @samp{S} +@tab search (posts, users, tags) (NB: only posts you have interacted with) +@item @samp{I}, @samp{c}, @samp{d} +@tab view, create, and delete filters +@item @samp{R}, @samp{a}, @samp{j} +@tab view/accept/reject follow requests +@item @samp{G} +@tab view follow suggestions +@item @samp{V} +@tab view your favourited toots +@item @samp{K} +@tab view bookmarked toots +@item @samp{X} +@tab view/edit/create/delete lists +@item @samp{s} +@tab view your scheduled toots +@item +@tab @strong{Toot actions} +@item @samp{t} +@tab Compose a new toot +@item @samp{c} +@tab Toggle content warning content +@item @samp{b} +@tab Boost toot under @samp{point} +@item @samp{f} +@tab Favourite toot under @samp{point} +@item @samp{k} +@tab toggle bookmark of toot at point +@item @samp{r} +@tab Reply to toot under @samp{point} +@item @samp{v} +@tab Vote on poll at point +@item @samp{C} +@tab copy url of toot at point +@item @samp{C-RET} +@tab play video/gif at point (requires @samp{mpv}) +@item @samp{e} +@tab edit your toot at point +@item @samp{E} +@tab view edits of toot at point +@item @samp{i} +@tab (un)pin your toot at point +@item @samp{d} +@tab delete your toot at point, and reload current timeline +@item @samp{D} +@tab delete and redraft toot at point, preserving reply/CW/visibility +@item (@samp{S-C-}) @samp{W}, @samp{M}, @samp{B} +@tab (un)follow, (un)mute, (un)block author of toot at point +@item +@tab @strong{Profile view} +@item @samp{C-c C-c} +@tab cycle between statuses, followers, following, and statuses without boosts +@item +@tab @samp{mastodon-profile--account-account-to-list} (see lists view) +@item +@tab @strong{Notifications view} +@item @samp{a}, @samp{j} +@tab accept/reject follow request +@item @samp{C-k} +@tab clear notification at point +@item +@tab see @samp{mastodon-notifications--get-*} functions for filtered views +@item +@tab @strong{Quitting} +@item @samp{q} +@tab Quit mastodon buffer, leave window open +@item @samp{Q} +@tab Quit mastodon buffer and kill window +@item @samp{C-M-q} +@tab Quit and kill all mastodon buffers +@end multitable + +@item +@anchor{Toot byline legend}Toot byline legend + + +@multitable {aaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaa} +@headitem Marker +@tab Meaning +@item @samp{(B)} +@tab I boosted this toot +@item @samp{(F)} +@tab I favourited this toot +@item @samp{(🔖)} (or (@samp{K})) +@tab I bookmarked this toot +@end multitable +@end enumerate + +@node Composing toots +@subsection Composing toots + +@samp{M-x mastodon-toot} (or @samp{t} from a mastodon.el buffer). + +Pops a new buffer/window in @samp{text-mode} and @samp{mastodon-toot} minor mode. Enter the +contents of your toot here. @samp{C-c C-c} sends the toot. @samp{C-c C-k} cancels. +Both actions kill the buffer and window. + +Autocompletion of mentions and tags is provided by @samp{completion-at-point-functions} (capf) backends. @samp{mastodon-toot--enable-completion} is enabled by default. If you want to enable @samp{company-mode} in the toot compose buffer, set @samp{mastodon-toot--use-company-for-completion} to @samp{t}. (@samp{mastodon.el} used to run its own native company backends, but these have been removed in favour of capfs.) + +Replies preserve visibility status/content warnings, and include boosters by default. + +Server's max toot length, and attachment previews, are shown. + +You can download and use your instance's custom emoji +(@samp{mastodon-toot--download-custom-emoji}, @samp{mastodon-toot--enable-custom-emoji}). + +The compose buffer uses @samp{text-mode} so any configuration you have for that mode +will be enabled. If any of your existing config conflicts with @samp{mastodon-toot}, +you can disable it in the @samp{mastodon-toot-mode-hook}. For example, the default +value of that hook is as follows: + +@lisp +(add-hook 'mastodon-toot-mode-hook + (lambda () + (auto-fill-mode -1))) +@end lisp + +@enumerate +@item +@anchor{Keybindings (1)}Keybindings + + +@multitable {aaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Key +@tab Action +@item @samp{C-c C-c} +@tab Send toot +@item @samp{C-c C-k} +@tab Cancel toot +@item @samp{C-c C-w} +@tab Add content warning +@item @samp{C-c C-v} +@tab Change toot visibility +@item @samp{C-c C-n} +@tab Add sensitive media/nsfw flag +@item @samp{C-c C-a} +@tab Upload attachment(s) +@item @samp{C-c !} +@tab Remove all attachments +@item @samp{C-c C-e} +@tab Add emoji (if @samp{emojify} installed) +@item @samp{C-c C-p} +@tab Create a poll +@item @samp{C-c C-l} +@tab Set toot language +@end multitable + +@item +@anchor{Draft toots}Draft toots + + +@itemize +@item +Compose buffer text is saved as you type, kept in @samp{mastodon-toot-current-toot-text}. +@item +@samp{mastodon-toot--save-draft}: save the current toot as a draft. +@item +@samp{mastodon-toot--open-draft-toot}: Open a compose buffer and insert one of your draft toots. +@item +@samp{mastodon-toot--delete-draft-toot}: Delete a draft toot. +@item +@samp{mastodon-toot--delete-all-drafts}: Delete all your drafts. +@end itemize +@end enumerate + +@node Other commands and account settings +@subsection Other commands and account settings: + +In addition to @samp{mastodon}, the following three functions are autoloaded and should +work without first loading @samp{mastodon.el}: +@itemize +@item +@samp{mastodon-toot}: Compose new toot +@item +@samp{mastodon-notifications-get}: View all notifications +@item +@samp{mastodon-url-lookup}: Attempt to load a URL in @samp{mastodon.el}. URL may be at +point or provided in the minibuffer. +@end itemize + + +@itemize +@item +@samp{mastodon-tl--view-instance-description}: View information about the instance +that the author of the toot at point is on. +@item +@samp{mastodon-tl--view-own-instance}: View information about your own instance. +@item +@samp{mastodon-search--trending-tags}: View a list of trending hashtags on your +instance. +@end itemize + + +@itemize +@item +@samp{mastodon-tl--add-toot-account-at-point-to-list}: Add the account of the toot at point to a list. +@end itemize + + +@itemize +@item +@samp{mastodon-tl--dm-user}: Send a direct message to one of the users at point. +@end itemize + + +@itemize +@item +@samp{mastodon-profile--add-private-note-to-account}: Add a private note to another user’s account. +@item +@samp{mastodon-profile--view-account-private-note}: View a private note on a user’s account. +@end itemize + + +@itemize +@item +@samp{mastodon-profile--show-familiar-followers}: Show a list of “familiar followers” for a given account. Familiar followers are accounts that you follow, and that follow the account. +@end itemize + + +@itemize +@item +@samp{mastodon-tl--follow-tag}: Follow a tag (works like following a user) +@item +@samp{mastodon-tl--unfollow-tag}: Unfollow a tag +@item +@samp{mastodon-tl--list-followed-tags}: View a list of tags you're following. +@end itemize + + +@itemize +@item +@samp{mastodon-switch-to-buffer}: switch between mastodon buffers. +@end itemize + + +@itemize +@item +@samp{mastodon-profile--update-display-name}: Update the display name for your +account. +@item +@samp{mastodon-profile--update-user-profile-note}: Update your bio note. +@item +@samp{mastodon-profile--update-meta-fields}: Update your metadata fields. +@item +@samp{mastodon-profile--set-default-toot-visibility}: Set the default visibility +for your toots. +@item +@samp{mastodon-profile--account-locked-toggle}: Toggle the locked status of your +account. Locked accounts have to manually approve follow requests. +@item +@samp{mastodon-profile--account-discoverable-toggle}: Toggle the discoverable +status of your account. Non-discoverable accounts are not listed in the +profile directory. +@item +@samp{mastodon-profile--account-bot-toggle}: Toggle whether your account is flagged +as a bot. +@item +@samp{mastodon-profile--account-sensitive-toggle}: Toggle whether your posts are +marked as sensitive (nsfw) by default. +@end itemize + +@node Customization +@subsection Customization + +See @samp{M-x customize-group RET mastodon} to view all customize options. + +@itemize +@item +Timeline options: +@itemize +@item +Use proportional fonts +@item +Default number of posts displayed +@item +Timestamp format +@item +Relative timestamps +@item +Display user avatars +@item +Avatar image height +@item +Enable image caching +@item +Hide replies in timelines +@item +Show toot stats in byline +@end itemize + +@item +Compose options: +@itemize +@item +Completion style for mentions and tags +@item +Enable custom emoji +@item +Display toot being replied to +@item +Set default reply visibility +@end itemize +@end itemize + +@node Alternative timeline layout +@subsection Alternative timeline layout + +The incomparable Nicholas Rougier has written an alternative timeline layout for @samp{mastodon.el}. + +The repo is at @uref{https://github.com/rougier/mastodon-alt}. + +@node Live-updating timelines @samp{mastodon-async-mode} +@subsection Live-updating timelines: @samp{mastodon-async-mode} + +(code taken from @uref{https://github.com/alexjgriffith/mastodon-future.el}.) + +Works for federated, local, and home timelines and for notifications. It's a +little touchy, one thing to avoid is trying to load a timeline more than once +at a time. It can go off the rails a bit, but it's still pretty cool. The +current maintainer of @samp{mastodon.el} is unable to debug or improve this feature. + +To enable, it, add @samp{(require 'mastodon-async)} to your @samp{init.el}. Then you can +view a timeline with one of the commands that begin with +@samp{mastodon-async--stream-}. + +@node Translating toots +@subsection Translating toots + +You can translate toots with @samp{mastodon-toot--translate-toot-text} (@samp{a} in a timeline). At the moment +this requires @uref{https://codeberg.org/martianh/lingva.el, lingva.el}, a little interface I wrote to @uref{https://lingva.ml}, to +be installed to work. + +You could easily modify the simple function to use your Emacs translator of +choice (@samp{libretrans.el} , @samp{google-translate}, @samp{babel}, @samp{go-translate}, etc.), you just +need to fetch the toot's content with @samp{(mastodon-tl--content toot)} and pass it +to your translator function as its text argument. Here's what +@samp{mastodon-toot--translate-toot-text} looks like: + +@lisp +(defun mastodon-toot--translate-toot-text () + "Translate text of toot at point. + Uses `lingva.el'." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json))) + (if toot + (lingva-translate nil (mastodon-tl--content toot)) + (message "No toot to translate?")))) +@end lisp + +@node bookmarks and @samp{mastodonel} +@subsection bookmarks and @samp{mastodon.el} + +@samp{mastodon.el} doesn’t currently implement its own bookmark record and handler, which means that emacs bookmarks will not work as is. Until we implement them, you can get bookmarks going immediately by using @uref{https://github.com/emacsmirror/emacswiki.org/blob/master/bookmark%2b.el, bookmark+.el}. + +@node Dependencies +@section Dependencies + +Hard dependencies (should all install with @samp{mastodon.el}): +@itemize +@item +@samp{request} (for uploading attachments), @uref{https://github.com/tkf/emacs-request} +@item +@samp{persist} for storing some settings across sessions +@item +@samp{ts} for poll relative expiry times +@end itemize + +Optional dependencies: +@itemize +@item +@samp{emojify} for inserting and viewing emojis +@item +@samp{mpv} and @samp{mpv.el} for viewing videos and gifs +@item +@samp{lingva.el} for translating toots +@end itemize + +@node Network compatibility +@section Network compatibility + +@samp{mastodon.el} should work with ActivityPub servers that implement the Mastodon API@. + +Apart from Mastodon itself, it is currently known to work with Pleroma and +Gotosocial. If you attempt to use @samp{mastodon.el} with another server that +implements the Mastodon API and run into problems, feel free to open an issue. + +@node Contributing +@section Contributing + +PRs, issues, feature requests, and general feedback are very welcome! + +@menu +* Bug reports:: +* Fixes and features:: +* Coding style:: +@end menu + +@node Bug reports +@subsection Bug reports + +@enumerate +@item +@samp{mastodon.el} has bugs, as well as lots of room for improvement. +@item +I receive very little feedback, so if I don't run into the bug it often doesn't get fixed. +@item +If you run into something that seems broken, first try running @samp{mastodon.el} +in emacs with no init file (i.e. @samp{emacs -q} (instructions and code for doing +this are @uref{https://codeberg.org/martianh/mastodon.el/issues/300, here}) to see if it also happens independently of your own config +(it probably does). +@item +Enable debug on error (@samp{toggle-debug-on-error}), make the bug happen again, +and copy the backtrace that appears. +@item +Open an issue here and explain what is going on. Provide your emacs version and what kind of server your account is on. +@end enumerate + +@node Fixes and features +@subsection Fixes and features + +@enumerate +@item +Create an @uref{https://codeberg.org/martianh/mastodon.el/issues, issue} detailing what you'd like to do. +@item +Fork the repository and create a branch off of @samp{develop}. +@item +Run the tests and ensure that your code doesn't break any of them. +@item +Create a pull request referencing the issue created in step 1. +@end enumerate + +@node Coding style +@subsection Coding style + +@itemize +@item +This library uses an unconvential double dash (@samp{--}) between file namespaces and function names, which contradicts normal Elisp style. This needs to be respected until the whole library is changed. +@item +Use @samp{aggressive-indent-mode} or similar to keep your code indented. +@item +Single spaces end sentences in docstrings. +@item +There's no need for a blank line after the first docstring line (one is added automatically when documentation is displayed). +@end itemize + +@node Supporting @samp{mastodonel} +@section Supporting @samp{mastodon.el} + +If you'd like to support continued development of @samp{mastodon.el}, I accept +donations via paypal: @uref{https://paypal.me/martianh, paypal.me/martianh}. If you would +prefer a different payment method, write to me at that address and I can +provide IBAN or other details. + +I don't have a tech worker's income, so even a small tip would help out. + +@node Contributors +@section Contributors + +@samp{mastodon.el} is the work of a number of people. + +Some significant contributors are: + +@itemize +@item +@uref{https://github.com/jdenen} [original author] +@item +@uref{http://atomized.org} +@item +@uref{https://alexjgriffith.itch.io} +@item +@uref{https://github.com/hdurer} +@item +@uref{https://codeberg.org/Red_Starfish} +@end itemize + +@bye
\ No newline at end of file diff --git a/test/ert-helper.el b/test/ert-helper.el index 230baf2..984a8ae 100644 --- a/test/ert-helper.el +++ b/test/ert-helper.el @@ -3,7 +3,6 @@ (load-file "lisp/mastodon-toot.el") (load-file "lisp/mastodon.el") (load-file "lisp/mastodon-search.el") -(load-file "lisp/mastodon-async.el") (load-file "lisp/mastodon-client.el") (load-file "lisp/mastodon-auth.el") (load-file "lisp/mastodon-discover.el") @@ -13,6 +12,7 @@ (load-file "lisp/mastodon-profile.el") (load-file "lisp/mastodon-search.el") (load-file "lisp/mastodon-tl.el") +(load-file "lisp/mastodon-async.el") ;; load tests in bulk to avoid using deprecated `cask exec' (let ((tests (cl-remove-if-not (lambda (x) diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index 2d9d6df..af41036 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -1,6 +1,8 @@ ;;; mastodon-auth-test.el --- Tests for mastodon-auth.el -*- lexical-binding: nil -*- (require 'el-mock) +(require 'mastodon) +(require 'mastodon-auth) (ert-deftest mastodon-auth--handle-token-response--good () "Should extract the access token from a good response." diff --git a/test/mastodon-notifications-tests.el b/test/mastodon-notifications-tests.el index 942a7cb..2517c9d 100644 --- a/test/mastodon-notifications-tests.el +++ b/test/mastodon-notifications-tests.el @@ -183,15 +183,14 @@ (statuses_count . 101) (note . "E")))) -(ert-deftest mastodon-notifications--notification-get () - "Ensure get request format for notifictions is accurate." - (let ((mastodon-instance-url "https://instance.url")) - (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" nil)) - (mock (mastodon-profile--fetch-server-account-settings) - => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) - - (mastodon-notifications-get)))) +;; (ert-deftest mastodon-notifications--notification-get () +;; "Ensure get request format for notifictions is accurate." +;; (let ((mastodon-instance-url "https://instance.url")) +;; (with-mock +;; (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" nil)) +;; (mock (mastodon-profile--fetch-server-account-settings) +;; => '(max_toot_chars 1312 privacy "public" display_name "Eugen" discoverable t locked :json-false bot :json-false sensitive :json-false language "")) +;; (mastodon-notifications-get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 1ce9514..56cb852 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -54,7 +54,7 @@ (fields . []))) (defconst gargon-statuses-json - `[((id . "123456789012345678") + `(((id . "123456789012345678") (created_at . "2021-11-11T11:11:11.111Z") (in_reply_to_id) (in_reply_to_account_id) @@ -112,7 +112,7 @@ (tags . []) (emojis . []) (card) - (poll))]) + (poll)))) (ert-deftest mastodon-profile--add-author-bylines () "Should correctly format short infos about one account. diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 726e21a..a284c25 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -307,15 +307,16 @@ Strict-Transport-Security: max-age=31536000 (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--toot-stats mastodon-tl-test-base-toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - (handle-location 20)) + (handle-location 20)) (should (string= (substring-no-properties - byline) - "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + byline) + "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ ")) (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) @@ -332,6 +333,7 @@ Strict-Transport-Security: max-age=31536000 (with-mock (stub create-image => '(image "fake data")) (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--toot-stats mastodon-tl-test-base-toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") (should (string= (substring-no-properties @@ -348,15 +350,16 @@ Strict-Transport-Security: max-age=31536000 (toot (cons '(reblogged . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (mastodon-tl--symbol 'boost) => "B") - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--symbol 'boost) => "B") + (mock (mastodon-tl--toot-stats toot) => "") + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -366,15 +369,16 @@ Strict-Transport-Security: max-age=31536000 (toot (cons '(favourited . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (mastodon-tl--symbol 'favourite) => "F") - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (mastodon-tl--symbol 'favourite) => "F") + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (mastodon-tl--toot-stats toot) => "") + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -385,6 +389,7 @@ Strict-Transport-Security: max-age=31536000 (toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock + (mock (mastodon-tl--toot-stats toot) => "") (mock (date-to-time timestamp) => '(22782 21551)) ;; FIXME this mock refuses to recognise our different args ;; (mock (mastodon-tl--symbol 'favourite) => "F") @@ -413,22 +418,23 @@ Strict-Transport-Security: max-age=31536000 (mock (date-to-time timestamp) => '(1 2)) (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) + (mock (mastodon-tl--toot-stats toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") (let ((byline (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (handle1-location 20) - (handle2-location 65)) + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (handle1-location 20) + (handle2-location 65)) (should (string= (substring-no-properties byline) - "Account 42 (@acct42@example.space) + "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ ")) (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle1-location 'help-echo byline) - "Browse user profile of @acct42@example.space")) + "Browse user profile of @acct42@example.space")) (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) 'user-handle)) (should (equal (get-text-property handle2-location 'help-echo byline) @@ -449,6 +455,7 @@ Strict-Transport-Security: max-age=31536000 (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + (mock (mastodon-tl--toot-stats toot) => "") (should (string= (substring-no-properties (mastodon-tl--byline toot @@ -474,6 +481,7 @@ Strict-Transport-Security: max-age=31536000 ;; (mock (mastodon-tl--symbol 'favourite) => "F") ;; (mock (mastodon-tl--symbol 'boost) => "B") (mock (mastodon-tl--symbol *) => "?") + (mock (mastodon-tl--toot-stats toot) => "") (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") (mock (date-to-time original-timestamp) => '(3 4)) (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") |