diff options
| -rw-r--r-- | README.org | 140 | ||||
| -rw-r--r-- | fixture/client.plstore | 5 | ||||
| -rw-r--r-- | lisp/mastodon-auth.el | 201 | ||||
| -rw-r--r-- | lisp/mastodon-client.el | 110 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 8 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 17 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 43 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 109 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 62 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 395 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 79 | ||||
| -rw-r--r-- | lisp/mastodon.el | 51 | ||||
| -rw-r--r-- | test/ert-helper.el | 3 | ||||
| -rw-r--r-- | test/mastodon-auth-tests.el | 52 | ||||
| -rw-r--r-- | test/mastodon-client-tests.el | 101 |
15 files changed, 1003 insertions, 373 deletions
@@ -10,49 +10,51 @@ This is now the version available via MELPA. It adds the following features: -| Profiles: | | -| | display profile metadata fields | -| | display pinned toots first | -| | display relationship (follows you/followed by you) | -| | display toots/follows/followers counts | -| | links/tags/mentions in profile bios are active links | -| | show a lock icon for locked accounts | -| =R=, =C-c a=, =C-c r= | view/accept/reject follow requests | -| =V= | view your favorited toots | -| =i= | toggle pinning of toots | -| =S-C-P= | jump to your profile | -| =U= | update your profile bio note | -| =O= | jump to own profile | -| Notifications: | | -| | follow requests now also appear in notifications | -| =a=, =r= | accept/reject follow request | -| | notifications for when a user posts (=mastodon-tl--enable-notify-user-posts=) | -| Timelines: | | -| =C= | copy url of toot at point | -| =d= | delete your toot at point, and reload current timeline | -| =D= | delete and redraft toot at point, preserving reply/CW/visibility | -| =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | -| =k=, =K= | toggle bookmark of toot at point, view bookmarked toots | -| | display polls and vote on them | -| | images are links to the full image, can be zoomed/rotated/saved (see image keymap) | -| | images scale properly | -| | toot visibility (direct, followers only) icon appears in toot bylines | -| | display toot's number of favorites, boosts and replies | -| | play gifs and videos (requires =mpv= to be installed) | -| | customize option to cache images | -| Toots: | | -| | mention booster in replies by default | -| | replies preserve visibility status/CW of original toot | -| | autocompletion of user mentions, via =company-mode= (must be installed to work) | -| =C-c C-a= | media uploads, asynchronous | -| | media upload previews displayed in toot compose buffer | -| =C-c C-n= | and sensitive media/nsfw flag | -| =C-c C-e= | add emoji (if =emojify= installed) | -| | download and use your instance's custom emoji | -| | server's maximum toot length shown in toot compose buffer | -| Search: | | -| =S= | search (posts, users, tags) (NB: only posts you have interacted with are searched) | -| | | +| Profiles: | | +| | display profile metadata fields | +| | display pinned toots first | +| | display relationship (follows you/followed by you) | +| | display toots/follows/followers counts | +| | links/tags/mentions in profile bios are active links | +| | show a lock icon for locked accounts | +| =G= | view follow suggestions | +| =R=, =a=, =r= | view/accept/reject follow requests | +| =V= | view your favorited toots | +| =i= | toggle pinning of toots | +| =U= | update your profile bio note | +| =O= | jump to own profile | +| Notifications: | | +| | follow requests now also appear in notifications | +| =a=, =j= | accept/reject follow request | +| | notifications for when a user posts (=mastodon-tl--enable-notify-user-posts=) | +| Timelines: | | +| =C= | copy url of toot at point | +| =d= | delete your toot at point, and reload current timeline | +| =D= | delete and redraft toot at point, preserving reply/CW/visibility | +| =W=, =M=, =B= | (un)follow, (un)mute, (un)block author of toot at point | +| =k=, =K= | toggle bookmark of toot at point, view bookmarked toots | +| =I=, =c=, =d= | view, create, and delete filters | +| | display image captions | +| | display polls and vote on them | +| | images are links to the full image, can be zoomed/rotated/saved (see image keymap) | +| | images scale properly | +| | toot visibility (direct, followers only) icon appears in toot bylines | +| | display toot's number of favorites, boosts and replies | +| | play gifs and videos (requires =mpv= to be installed) | +| | customize option to cache images | +| Toots: | | +| | mention booster in replies by default | +| | replies preserve visibility status/CW of original toot | +| | autocompletion of user mentions, via =company-mode= (must be installed to work) | +| =C-c C-a= | media uploads, asynchronous | +| | media upload previews displayed in toot compose buffer | +| =C-c C-n= | and sensitive media/nsfw flag | +| =C-c C-e= | add emoji (if =emojify= installed) | +| | download and use your instance's custom emoji | +| | server's maximum toot length shown in toot compose buffer | +| Search: | | +| =S= | search (posts, users, tags) (NB: only posts you have interacted with are searched) | +| | | It also makes some small cosmetic changes to make timelines easier to read, and makes some functions asynchronous, based on https://github.com/ieure/mastodon.el. @@ -66,6 +68,23 @@ Works for federated, local, and home timelines and for notifications. It's a lit 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-=. +** translating toots + +You can translate toots with =mastodon-toot--translate-toot-text=. At the moment this requires [[https://codeberg.org/martianh/lingva.el][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 (=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: + +#+begin_src emacs-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_src + ** NB: dependencies This version depends on the library =request= (for uploading attachments). You can install it from MELPA, or https://github.com/tkf/emacs-request. It also depends on =seq=. @@ -74,6 +93,7 @@ Optional dependencies: - =company= for autocompletion of mentions when composing a toot - =emojify= for inserting and viewing emojis - =mpv= and =mpv.el= for viewing videos and gifs +- =lingva.el= for translating toots ** NB: bugs @@ -81,13 +101,9 @@ This repo also incorporates fixes for two bugs that were never merged into the u - https://github.com/jdenen/mastodon.el/issues/227 (and https://github.com/jdenen/mastodon.el/issues/234) - https://github.com/jdenen/mastodon.el/issues/228 -** 2FA - -It looks like 2-factor auth was never completed in the original repo. It's not a priority for me, auth ain't my thing. If you want to hack on it, its on the develop branch in the original repo. - ** contributing -Contributions are welcome! +Contributions are welcome. 1. Create an here on codeberg detailing the feature you'd like to add. 2. Fork the repository and create a branch off of =develop=. @@ -155,21 +171,31 @@ Or, with =use-package=: #+END_SRC ** Usage -*** 2 Factor Auth -2FA is not supported yet. It is in the [[https://github.com/jdenen/mastodon.el/milestone/2][plans]] for the =1.0.0= release. - -If you have 2FA enabled and try to use mastodon.el, your Emacs client will hang until you `C-g` your way out. *** Instance -Set =mastodon-instance-url= in your =.emacs= or =customize=. Defaults to the [[https://mastodon.social][flagship]]. +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: #+BEGIN_SRC emacs-lisp - (setq mastodon-instance-url "https://my.instance.url") + (setq mastodon-instance-url "https://social.instance.org" + mastodon-active-user "example_user") #+END_SRC -There is an option to have your user credentials (email address and password) saved to disk so you don't have to re-enter them on every restart. -The default is not to do this because if not properly configured it would save these unencrypted which is not a good default to have. -Customize the variable =mastodon-auth-source-file= if you want to enable this feature. +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 have been using mastodon.el before this change and the above +steps do not work it's advisable that you delete the old file specified +by =mastodon-client--token-file= and restart Emacs and follow the steps +again. *** Timelines diff --git a/fixture/client.plstore b/fixture/client.plstore index e050018..48d951c 100644 --- a/fixture/client.plstore +++ b/fixture/client.plstore @@ -1,3 +1,6 @@ ;;; public entries -*- mode: plstore -*- (("mastodon-http://other.example" :client_id "id1" :client_secret "secret1") - ("mastodon-http://mastodon.example" :client_id "id2" :client_secret "secret2")) + ("mastodon-http://mastodon.example" :client_id "id2" :client_secret "secret2") + ("user-test8000@mastodon.example" :username "test8000@mastodon.example" :instance "http://mastodon.example" :client_id "id2" :client_secret "secret2" :access_token "token2") + ("active-user" :username "test9000@other.example" :instance "http://other.example" :client_id "id1" :client_secret "secret1" :access_token "token1") + ("user-test9000@other.example" :username "test9000@other.example" :instance "http://other.example" :client_id "id1" :client_secret "secret1" :access_token "token1")) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 1fb1604..2f333b7 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -1,6 +1,7 @@ ;;; mastodon-auth.el --- Auth functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org> ;; Author: Johnson Denen <johnson.denen@gmail.com> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> ;; Version: 0.10.0 @@ -39,21 +40,25 @@ (autoload 'mastodon-http--api "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) +(defvar mastodon-active-user) (defgroup mastodon-auth nil "Authenticate with Mastodon." :prefix "mastodon-auth-" :group 'mastodon) -(defcustom mastodon-auth-source-file "" - "Filename to use to store user names and passwords. - -Leave empty to not permanently store any secrets. -Otherwise set to e.g. \"~/.authinfo.gpg\" to have encrypted storage, or -if you are happy with unencryped storage use e.g. \"~/authinfo\"." - :group 'mastodon-auth - :type 'string) +(defvar mastodon-auth-source-file nil + "This variable is obsolete. +This variable currently serves no purpose and will be removed in +the future.") (defvar mastodon-auth--token-alist nil "Alist of User access tokens keyed by instance url.") @@ -61,60 +66,95 @@ if you are happy with unencryped storage use e.g. \"~/authinfo\"." (defvar mastodon-auth--acct-alist nil "Alist of account accts (name@domain) keyed by instance url.") +(defvar mastodon-auth--user-unaware + " ** MASTODON.EL - NOTICE ** + +It appears that you are not aware of the recent developments in +mastodon.el. In short we now require that you also set the +variable `mastodon-active-user' in your init file in addition to +`mastodon-instance-url'. + +Please see its documentation to understand what value it accepts +by running M-x describe-variable on it or visiting our web page: +https://codeberg.org/martianh/mastodon.el + +We apologize for the inconvenience. +") + +(defun mastodon-auth--get-browser-login-url () + "Return properly formed browser login url." + (mastodon-http--append-query-string + (concat mastodon-instance-url "/oauth/authorize/") + `(("response_type" "code") + ("redirect_uri" ,mastodon-client-redirect-uri) + ("scope" ,mastodon-client-scopes) + ("client_id" ,(plist-get (mastodon-client) :client_id))))) + +(defvar mastodon-auth--explanation + (format + " +1. A URL has been copied to your clipboard. Open this URL in a +javascript capable browser and your browser will take you to your +Mastodon instance's login page. + +2. Login to your account (%s) and authorize \"mastodon.el\". + +3. After authorization you will be presented an authorization +code. Copy this code and paste it in the minibuffer prompt." + (mastodon-client--form-user-from-vars))) + +(defun mastodon-auth--show-notice (notice buffer-name &optional ask) + "Display NOTICE to user. +NOTICE is displayed in vertical split occupying 50% of total +width. The buffer name of the buffer being displayed in the +window is BUFFER-NAME. + +When optional argument ASK is given which should be a string, use +ASK as the minibuffer prompt. Return whatever user types in +response to the prompt. + +When ASK is absent return nil." + (let ((buffer (get-buffer-create buffer-name)) + (inhibit-read-only t) + ask-value window) + (set-buffer buffer) + (erase-buffer) + (insert notice) + (fill-region (point-min) (point-max)) + (read-only-mode) + (setq window (select-window + (split-window (frame-root-window) nil 'left) + t)) + (switch-to-buffer buffer t) + (when ask + (setq ask-value (read-string ask)) + (kill-buffer buffer) + (delete-window window)) + ask-value)) + +(defun mastodon-auth--request-authorization-code () + "Ask authorization code and return it." + (let ((url (mastodon-auth--get-browser-login-url)) + authorization-code) + (kill-new url) + (setq authorization-code + (mastodon-auth--show-notice mastodon-auth--explanation + "*mastodon-notice*" + "Authorization Code: ")) + authorization-code)) + (defun mastodon-auth--generate-token () - "Make POST to generate auth token. - -If no auth-sources file, runs -`mastodon-auth--generate-token-no-storing-credentials'. If -auth-sources file exists, runs -`mastodon-auth--generate-token-and-store'." - (if (or (null mastodon-auth-source-file) - (string= "" mastodon-auth-source-file)) - (mastodon-auth--generate-token-no-storing-credentials) - (mastodon-auth--generate-token-and-store))) - -(defun mastodon-auth--generate-token-no-storing-credentials () - "Make POST to generate auth token, without using auth-sources file." - (mastodon-http--post - (concat mastodon-instance-url "/oauth/token") - `(("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" . "password") - ("username" . ,(read-string "Email: " user-mail-address)) - ("password" . ,(read-passwd "Password: ")) - ("scope" . "read write follow")) - nil - :unauthenticated)) - -(defun mastodon-auth--generate-token-and-store () - "Make POST to generate auth token. - -Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." - (let* ((auth-sources (list mastodon-auth-source-file)) - (auth-source-creation-prompts - '((user . "Enter email for %h: ") - (secret . "Password: "))) - (credentials-plist (nth 0 (auth-source-search - :create t - :host mastodon-instance-url - :port 443 - :require '(:user :secret))))) - (prog1 - (mastodon-http--post - (concat mastodon-instance-url "/oauth/token") - `(("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" . "password") - ("username" . ,(plist-get credentials-plist :user)) - ("password" . ,(let ((secret (plist-get credentials-plist :secret))) - (if (functionp secret) - (funcall secret) - secret))) - ("scope" . "read write follow")) - nil - :unauthenticated) - (when (functionp (plist-get credentials-plist :save-function)) - (funcall (plist-get credentials-plist :save-function)))))) + "Generate access_token for the user. Return response buffer." + (let ((authorization-code (mastodon-auth--request-authorization-code))) + (mastodon-http--post + (concat mastodon-instance-url "/oauth/token") + `(("grant_type" . "authorization_code") + ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) + ("client_id" . ,(plist-get (mastodon-client) :client_id)) + ("code" . ,authorization-code) + ("redirect_uri" . ,mastodon-client-redirect-uri)) + nil + :unauthenticated))) (defun mastodon-auth--get-token () "Make a request to generate an auth token and return JSON response." @@ -128,16 +168,33 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." (json-read-from-string json-string)))) (defun mastodon-auth--access-token () - "Return exiting or generate new access token. - -If an access token for `mastodon-instance-url' is in -`mastodon-auth--token-alist', return it. - -Otherwise, generate a token and pass it to -`mastodon-auth--handle-token-reponse'." - (if-let ((token (cdr (assoc mastodon-instance-url mastodon-auth--token-alist)))) - token - (mastodon-auth--handle-token-response (mastodon-auth--get-token)))) + "Return the access token to use with `mastodon-instance-url'. + +Generate/save token if none known yet." + (cond (mastodon-auth--token-alist + ;; user variables are known and + ;; initialised already. + (alist-get mastodon-instance-url mastodon-auth--token-alist + nil nil 'equal)) + ((plist-get (mastodon-client--active-user) :access_token) + ;; user variables needs to initialised by reading from + ;; plstore. + (push (cons mastodon-instance-url + (plist-get (mastodon-client--active-user) :access_token)) + mastodon-auth--token-alist) + (alist-get mastodon-instance-url mastodon-auth--token-alist + nil nil 'equal)) + ((null mastodon-active-user) + ;; user not aware of 2FA related changes and has not set the + ;; `mastodon-active-user' properly. Make user aware and error + ;; out. + (mastodon-auth--show-notice mastodon-auth--user-unaware + "*mastodon-notice*") + (error "Variables not set properly")) + (t + ;; user access-token needs to fetched from the server and + ;; stored and variables initialised. + (mastodon-auth--handle-token-response (mastodon-auth--get-token))))) (defun mastodon-auth--handle-token-response (response) "Add token RESPONSE to `mastodon-auth--token-alist'. @@ -148,6 +205,8 @@ Handle any errors from the server." (pcase response ((and (let token (plist-get response :access_token)) (guard token)) + (mastodon-client--make-user-active + (mastodon-client--store-access-token token)) (cdar (push (cons mastodon-instance-url token) mastodon-auth--token-alist))) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index 42e8b1f..4fc8db7 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -1,6 +1,7 @@ ;;; mastodon-client.el --- Client functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org> ;; Author: Johnson Denen <johnson.denen@gmail.com> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> ;; Version: 0.10.0 @@ -32,8 +33,10 @@ (require 'plstore) (require 'json) +(require 'url) (defvar mastodon-instance-url) +(defvar mastodon-active-user) (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") @@ -46,14 +49,26 @@ (defvar mastodon-client--client-details-alist nil "An alist of Client id and secrets keyed by the instance url.") +(defvar mastodon-client--active-user-details-plist nil + "A plist of active user details.") + +(defvar mastodon-client-scopes "read write follow" + "Scopes to pass to oauth during registration.") + +(defvar mastodon-client-website "https://codeberg.org/martianh/mastodon.el" + "Website of mastodon.el.") + +(defvar mastodon-client-redirect-uri "urn:ietf:wg:oauth:2.0:oob" + "Redirect_uri as required by oauth.") + (defun mastodon-client--register () "POST client to Mastodon." (mastodon-http--post (mastodon-http--api "apps") - '(("client_name" . "mastodon.el") - ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") - ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) + `(("client_name" . "mastodon.el") + ("redirect_uris" . ,mastodon-client-redirect-uri) + ("scopes" . ,mastodon-client-scopes) + ("website" . ,mastodon-client-website)) nil :unauthenticated)) @@ -88,11 +103,96 @@ Make `mastodon-client--fetch' call to determine client values." (plstore-close plstore) client)) +(defun mastodon-client--remove-key-from-plstore (plstore) + "Remove KEY from PLSTORE." + (cdr plstore)) + +;; Actually it returns a plist with client-details if such details are +;; already stored in mastodon.plstore (defun mastodon-client--read () "Retrieve client_id and client_secret from `mastodon-client--token-file'." (let* ((plstore (plstore-open (mastodon-client--token-file))) (mastodon (plstore-get plstore (concat "mastodon-" mastodon-instance-url)))) - (cdr mastodon))) + (mastodon-client--remove-key-from-plstore mastodon))) + +(defun mastodon-client--general-read (key) + "Retrieve the plstore item keyed by KEY. +Return plist without the KEY." + (let* ((plstore (plstore-open (mastodon-client--token-file))) + (plstore-item (plstore-get plstore key))) + (mastodon-client--remove-key-from-plstore plstore-item))) + +(defun mastodon-client--make-user-details-plist () + "Make a plist with current user details. Return it." + `(:username ,(mastodon-client--form-user-from-vars) + :instance ,mastodon-instance-url + :client_id ,(plist-get (mastodon-client) :client_id) + :client_secret ,(plist-get (mastodon-client) :client_secret))) + +(defun mastodon-client--store-access-token (token) + "Save TOKEN as :access_token in plstore of the current user. +Return the plist after the operation." + (let* ((user-details (mastodon-client--make-user-details-plist)) + (plstore (plstore-open (mastodon-client--token-file))) + (username (plist-get user-details :username)) + (plstore-value (setq user-details + (plist-put user-details :access_token token))) + (print-length nil) + (print-level nil)) + (plstore-put plstore (concat "user-" username) plstore-value nil) + (plstore-save plstore) + (plstore-close plstore) + plstore-value)) + +(defun mastodon-client--make-user-active (user-details) + "USER-DETAILS is a plist consisting of user details." + (let ((plstore (plstore-open (mastodon-client--token-file))) + (print-length nil) + (print-level nil)) + (plstore-put plstore "active-user" user-details nil) + (plstore-save plstore) + (plstore-close plstore))) + +(defun mastodon-client--form-user-from-vars () + "Create a username from user variable. Return that username. + +Username in the form user@instance.com is formed from the +variables `mastodon-instance-url' and `mastodon-active-user'." + (concat mastodon-active-user + "@" + (url-host (url-generic-parse-url mastodon-instance-url)))) + +(defun mastodon-client--make-current-user-active () + "Make the user specified by user variables active user. +Return the details (plist)." + (let ((username (mastodon-client--form-user-from-vars)) + user-plist) + (when (setq user-plist + (mastodon-client--general-read (concat "user-" username))) + (mastodon-client--make-user-active user-plist)) + user-plist)) + +(defun mastodon-client--current-user-active-p () + "Return user-details if the current user is active. +Otherwise return nil." + (let ((username (mastodon-client--form-user-from-vars)) + (user-details (mastodon-client--general-read "active-user"))) + (when (and user-details + (equal (plist-get user-details :username) username)) + user-details))) + +(defun mastodon-client--active-user () + "Return the details of the currently active user. + +Details is a plist." + (let ((active-user-details mastodon-client--active-user-details-plist)) + (unless active-user-details + (setq active-user-details + (or (mastodon-client--current-user-active-p) + (mastodon-client--make-current-user-active))) + (setq mastodon-client--active-user-details-plist + active-user-details)) + active-user-details)) (defun mastodon-client () "Return variable client secrets to use for `mastodon-instance-url'. diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e288c18..35fd070 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -32,6 +32,7 @@ (require 'json) (require 'request) ; for attachments upload +(require 'url) (defvar mastodon-instance-url) (defvar mastodon-toot--media-attachment-ids) @@ -156,6 +157,13 @@ Pass response buffer to CALLBACK function." (with-temp-buffer (mastodon-http--url-retrieve-synchronously url)))) +(defun mastodon-http--append-query-string (url params) + "Append PARAMS to URL as query strings and return it. + +PARAMS should be an alist as required `url-build-query-string'." + (let ((query-string (url-build-query-string params))) + (concat url "?" query-string))) + ;; search functions: (defun mastodon-http--process-json-search () "Process JSON returned by a search query to the server." diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 9441bdb..e5a1111 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -307,12 +307,17 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type caption) "Return the string to be written that renders the image at MEDIA-URL. FULL-REMOTE-URL is used for `shr-browse-image'. -TYPE is the attachment's type field on the server." - (let ((help-echo - "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) +TYPE is the attachment's type field on the server. +CAPTION is the image caption if provided." + (let* ((help-echo-base "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") + (help-echo (if caption + (concat help-echo-base + "\n\"" + caption "\"") + help-echo-base))) (concat (propertize "[img]" 'media-url media-url @@ -324,7 +329,9 @@ TYPE is the attachment's type field on the server." 'mastodon-tab-stop 'image ; for do-link-action-at-point 'image-url full-remote-url ; for shr-browse-image 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (if (string= type "image") + 'help-echo (if (or (string= type "image") + (string= type nil) + (string= type "unknown")) ;handle borked images help-echo (concat help-echo "\nC-RET: play " type " with mpv"))) " "))) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 5e3305a..5de7354 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -86,7 +86,8 @@ With no argument, the request is accepted. Argument REJECT means reject the request. Can be called in notifications view or in follow-requests view." (interactive) - (when (mastodon-tl--find-property-range 'toot-json (point)) + (if (not (mastodon-tl--find-property-range 'toot-json (point))) + (message "No follow request at point?") (let* ((toot-json (mastodon-tl--property 'toot-json)) (f-reqs-view-p (string= "follow_requests" (plist-get mastodon-tl--buffer-spec 'endpoint))) @@ -109,7 +110,8 @@ follow-requests view." nil nil))) (mastodon-http--triage response (lambda () - (unless f-reqs-view-p + (if f-reqs-view-p + (mastodon-profile--view-follow-requests) (mastodon-notifications--get)) (message "Follow request of %s (@%s) %s!" name handle (if reject @@ -144,7 +146,7 @@ Can be called in notifications view or in follow-requests view." (defun mastodon-notifications--favourite (note) "Format for a `favourite' NOTE." - (mastodon-notifications--format-note note 'favorite)) + (mastodon-notifications--format-note note 'favourite)) (defun mastodon-notifications--reblog (note) "Format for a `boost' NOTE." @@ -166,12 +168,18 @@ Status notifications are given when (status (mastodon-tl--field 'status note)) (follower (alist-get 'username (alist-get 'account note)))) (mastodon-notifications--insert-status - (if (or (equal type 'follow) - (equal type 'follow-request)) - ;; Using reblog with an empty id will mark this as something - ;; non-boostable/non-favable. - (cons '(reblog (id . nil)) note) - status) + (cond ((or (equal type 'follow) + (equal type 'follow-request)) + ;; Using reblog with an empty id will mark this as something + ;; non-boostable/non-favable. + (cons '(reblog (id . nil)) note)) + ;; reblogs/faves use 'note' to process their own json + ;; not the toot's. this ensures following etc. work on such notifs + ((or (equal type 'favourite) + (equal type 'boost)) + note) + (t + status)) (if (or (equal type 'follow) (equal type 'follow-request)) (propertize (if (equal type 'follow) @@ -194,7 +202,7 @@ Status notifications are given when (mastodon-notifications--byline-concat (cond ((equal type 'boost) "Boosted") - ((equal type 'favorite) + ((equal type 'favourite) "Favourited") ((equal type 'follow-request) "Requested to follow") @@ -206,9 +214,12 @@ Status notifications are given when "Posted") ((equal type 'poll) "Posted a poll")))) - id))) + id + (when (or (equal type 'favourite) + (equal type 'boost)) + status)))) -(defun mastodon-notifications--insert-status (toot body author-byline action-byline id) +(defun mastodon-notifications--insert-status (toot body author-byline action-byline id &optional parent-toot) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. @@ -222,9 +233,11 @@ 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 the notification's own id, which is attached as a property." +ID is the notification's own id, which is attached as a property. +If the status is a favourite or a boost, PARENT-TOOT is the JSON +of the toot responded to." (when toot ; handle rare blank notif server bug - (mastodon-tl--insert-status toot body author-byline action-byline id))) + (mastodon-tl--insert-status toot body author-byline action-byline id parent-toot))) (defun mastodon-notifications--by-type (note) "Filters NOTE for those listed in `mastodon-notifications--types-alist'." @@ -239,7 +252,7 @@ ID is the notification's own id, which is attached as a property." (defun mastodon-notifications--timeline (json) "Format JSON in Emacs buffer." (if (equal json '[]) - (message "Looks like you have no notifications for the moment.") + (message "Looks like you have no (more) notifications for the moment.") (mapc #'mastodon-notifications--by-type json) (goto-char (point-min)))) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 5811a4a..6065bdd 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -55,12 +55,21 @@ (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") (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--update-point) +(defvar mastodon-mode-map) (defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") @@ -72,6 +81,20 @@ map) "Keymap for `mastodon-profile-mode'.") +(defvar mastodon-profile--view-follow-requests-keymap + (let ((map ;(make-sparse-keymap))) + (copy-keymap mastodon-mode-map))) + (define-key map (kbd "r") #'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. @@ -146,9 +169,31 @@ extra keybindings." (defun mastodon-profile--view-follow-requests () "Open a new buffer displaying the user's follow requests." (interactive) - (mastodon-tl--init "follow-requests" - "follow_requests" - 'mastodon-profile--add-author-bylines)) + (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 (equal 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--update-user-profile-note () "Fetch user's profile note and display for editing." @@ -162,6 +207,10 @@ extra keybindings." (buffer (get-buffer-create "*mastodon-update-profile*")) (inhibit-read-only t)) (switch-to-buffer-other-window buffer) + (setq-local header-line-format + (propertize + "Edit your profile note. C-c C-c to send, C-c C-k to cancel." + 'face font-lock-comment-face)) (mastodon-profile-update-mode t) (insert note) (goto-char (point-min)) @@ -335,7 +384,6 @@ Returns a list of lists." (mastodon-profile--insert-statuses-pinned pinned) (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots (funcall update-function json))) - ;;(mastodon-tl--goto-next-toot) (goto-char (point-min)))) (defun mastodon-profile--get-toot-author () @@ -356,19 +404,24 @@ If toot is a boost, opens the profile of the booster." "Query for USER-HANDLE from current status and show that user's profile." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "View profile of user [choose or enter any handle]: " - user-handles - nil ; predicate - 'confirm)))) - (let ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json)))) - (if account - (progn - (message "Loading profile of user %s..." user-handle) - (mastodon-profile--make-author-buffer account)) - (message "Cannot find a user with handle %S" user-handle)))) + (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (get-text-property (point) 'toot-json))) + (message "Looks like there's no toot or user at point?") + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read "View profile of user [choose or enter any handle]: " + user-handles + nil ; predicate + 'confirm))))) + (if (not (get-text-property (point) 'toot-json)) + (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)))) + (if account + (progn + (message "Loading profile of user %s..." user-handle) + (mastodon-profile--make-author-buffer account)) + (message "Cannot find a user with handle %S" user-handle))))) (defun mastodon-profile--my-profile () "Show the profile of the currently signed in user." @@ -383,10 +436,12 @@ FIELD is used to identify regions under 'account" (cdr (assoc field account))) (defun mastodon-profile--add-author-bylines (tootv) - "Convert TOOTV into a author-bylines and insert." + "Convert TOOTV into a author-bylines and insert. +Also insert their profile note. +Used to view a user's followers and those they're following." + ;;FIXME change the name of this fun now that we've edited what it does! (let ((inhibit-read-only t)) - (if (equal tootv '[]) - (message "Looks like you have no follow requests for the moment.") + (when (not (equal tootv '[])) (mapc (lambda (toot) (let ((start-pos (point))) (insert "\n" @@ -398,7 +453,9 @@ FIELD is used to identify regions under 'account" 'toot-json toot)) (mastodon-media--inline-images start-pos (point)) (insert "\n" - (mastodon-tl--render-text (alist-get 'note toot) nil) + (propertize + (mastodon-tl--render-text (alist-get 'note toot) nil) + 'toot-json toot) ' "\n"))) tootv)))) @@ -428,9 +485,13 @@ If the handle does not match a search return then retun NIL." These include the author, author of reblogged entries and any user mentioned." (when status - (let ((this-account (alist-get 'account status)) - (mentions (alist-get 'mentions status)) - (reblog (alist-get 'reblog status))) + (let ((this-account + (or (alist-get 'account status) ; status is a toot + status)) ; status is a user listing + (mentions (or (alist-get 'mentions (alist-get 'status status)) + (alist-get 'mentions status))) + (reblog (or (alist-get 'reblog (alist-get 'status status)) + (alist-get 'reblog status)))) (seq-filter 'stringp (seq-uniq diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index d17b054..cbb1fba 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -77,8 +77,9 @@ Returns a nested list containing user handle, display name, and URL." (accts (alist-get 'accounts response)) (tags (alist-get 'hashtags response)) (statuses (alist-get 'statuses response)) - (user-ids (mapcar #'mastodon-search--get-user-info - accts)) ; returns a list of three-item lists + ;; this is now done in search--insert-users-propertized + ;; (user-ids (mapcar #'mastodon-search--get-user-info + ;; accts)) ; returns a list of three-item lists (tags-list (mapcar #'mastodon-search--get-hashtag-info tags)) ;; (status-list (mapcar #'mastodon-search--get-status-info @@ -89,16 +90,16 @@ Returns a nested list containing user handle, display name, and URL." status-ids-list))) (with-current-buffer (get-buffer-create buffer) (switch-to-buffer buffer) - (erase-buffer) (mastodon-mode) (let ((inhibit-read-only t)) + (erase-buffer) ;; user results: (insert (mastodon-tl--set-face (concat "\n ------------\n" " USERS\n" " ------------\n\n") 'success)) - (mastodon-search--insert-users-propertized user-ids :note) + (mastodon-search--insert-users-propertized accts :note) ;; hashtag results: (insert (mastodon-tl--set-face (concat "\n ------------\n" @@ -124,30 +125,41 @@ Returns a nested list containing user handle, display name, and URL." (mapc 'mastodon-tl--toot toots-list-json) (goto-char (point-min)))))) -(defun mastodon-search--insert-users-propertized (users &optional note) - "Insert USERS list into the buffer. -If NOTE is non-nil, include user's profile note. -This is also called by `mastodon-tl--get-follow-suggestions'." - (mapc (lambda (el) - (insert (propertize (car el) 'face 'mastodon-display-name-face) - " : \n : " - (propertize (concat "@" (car (cdr el))) - 'face 'mastodon-handle-face - 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle - 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" (car (cdr el))) - 'help-echo (concat "Browse user profile of @" (car (cdr el)))) - " : \n" - (if note - (mastodon-tl--render-text (cadddr el) nil) - "") - "\n")) - users)) +(defun mastodon-search--insert-users-propertized (json &optional note) + "Insert users list into the buffer. +JSON is the data from the server.. If NOTE is non-nil, include +user's profile note. This is also called by +`mastodon-tl--get-follow-suggestions' and +`mastodon-profile--insert-follow-requests'." + (mapc (lambda (acct) + (let ((user (mastodon-search--get-user-info acct))) + (insert + (propertize + (concat (propertize (car user) + 'face 'mastodon-display-name-face + 'byline t + 'toot-id "0") + " : \n : " + (propertize (concat "@" (cadr user)) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + 'mastodon-tab-stop 'user-handle + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" (cadr user)) + 'help-echo (concat "Browse user profile of @" (cadr user))) + " : \n" + (if note + (mastodon-tl--render-text (cadddr user) nil) + "") + "\n") + 'toot-json acct)))) ; so named for compat w other processing functions + json)) (defun mastodon-search--get-user-info (account) "Get user handle, display name, account URL and profile note from ACCOUNT." - (list (alist-get 'display_name account) + (list (if (not (equal "" (alist-get 'display_name account))) + (alist-get 'display_name account) + (alist-get 'username account)) (alist-get 'acct account) (alist-get 'url account) (alist-get 'note account))) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e33aadf..3c96ecc 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -63,11 +63,15 @@ (autoload 'mastodon-notifications--get "mastodon-notifications" "Display NOTIFICATIONS in buffer." t) ; interactive (autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-search--get-user-info "mastodon-search") +(autoload 'mastodon-http--delete "mastodon-http") + (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) (defvar mastodon-toot-timestamp-format) (defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this +(defvar mastodon-mode-map) (defgroup mastodon-tl nil "Timelines in Mastodon." @@ -167,6 +171,27 @@ types of mastodon links and not just shr.el-generated ones.") 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 ;(make-sparse-keymap))) + (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 ;(make-sparse-keymap))) + (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--byline-link-keymap (when (require 'mpv nil :no-error) (let ((map (make-sparse-keymap))) @@ -279,6 +304,27 @@ Optionally start from POS." (mastodon-tl--goto-toot-pos 'previous-single-property-change 'mastodon-tl--update)) +(defun mastodon-tl--goto-first-item () + "Jump to first toot or item in buffer. +Used on initializing a timeline or thread." + ;; goto-next-toot assumes we already have toots, and is therefore + ;; incompatible with any view where it is possible to have no items. + ;; when that is the case the call to goto-toot-pos loops infinitely + (goto-char (point-min)) + (mastodon-tl--goto-next-item)) + +(defun mastodon-tl--goto-next-item () + "Jump to next item, e.g. filter or follow request." + (interactive) + (mastodon-tl--goto-toot-pos 'next-single-property-change + 'next-line)) + +(defun mastodon-tl--goto-prev-item () + "Jump to previous item, e.g. filter or follow request." + (interactive) + (mastodon-tl--goto-toot-pos 'previous-single-property-change + 'previous-line)) + (defun mastodon-tl--remove-html (toot) "Remove unrendered tags from TOOT." (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) @@ -311,21 +357,26 @@ Optionally start from POS." ;; echo faves count when point on post author name: ;; which is where --goto-next-toot puts point. 'help-echo - (mastodon-tl--format-faves-count toot)) + ;; but don't add it to "following"/"follows" on profile views: + ;; 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))) " (" (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 favorites, boosts, replies count for a 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 @@ -462,10 +513,19 @@ 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'" - (let ((parsed-time (date-to-time (mastodon-tl--field 'created_at toot))) - (faved (equal 't (mastodon-tl--field 'favourited toot))) - (boosted (equal 't (mastodon-tl--field 'reblogged toot))) - (visibility (mastodon-tl--field 'visibility toot))) + (let* ((created-time + ;; bosts and faves in notifs view + ;; (makes timestamps be for the original toot + ;; not the boost/fave): + (or (mastodon-tl--field 'created_at + (mastodon-tl--field 'status toot)) + ;; all other toots, inc. boosts/faves in timelines: + ;; (mastodon-tl--field auto fetches from reblogs if needed): + (mastodon-tl--field 'created_at toot))) + (parsed-time (date-to-time created-time)) + (faved (equal 't (mastodon-tl--field 'favourited toot))) + (boosted (equal 't (mastodon-tl--field 'reblogged toot))) + (visibility (mastodon-tl--field 'visibility toot))) (concat ;; Boosted/favourited markers are not technically part of the byline, so ;; we don't propertize them with 'byline t', as per the rest. This @@ -474,40 +534,40 @@ By default it is `mastodon-tl--byline-boosted'" ;; this makes the behaviour of these markers consistent whether they are ;; displayed for an already boosted/favourited toot or as the result of ;; the toot having just been favourited/boosted. - (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline "B")) - (when faved - (mastodon-tl--format-faved-or-boosted-byline "F"))) - (propertize - (concat - ;; we propertize help-echo format faves for author name - ;; in `mastodon-tl--byline-author' - (funcall author-byline toot) - (cond ((equal visibility "direct") - (if (fontp (char-displayable-p #10r128274)) - " ✉" - " [direct]")) - ((equal visibility "private") - (if (fontp (char-displayable-p #10r9993)) - " 🔒" - " [followers]"))) - (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 - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description parsed-time) - parsed-time)) - (propertize "\n ------------\n" 'face 'default)) + (concat (when boosted + (mastodon-tl--format-faved-or-boosted-byline "B")) + (when faved + (mastodon-tl--format-faved-or-boosted-byline "F"))) + (propertize + (concat + ;; we propertize help-echo format faves for author name + ;; in `mastodon-tl--byline-author' + (funcall author-byline toot) + (cond ((equal visibility "direct") + (if (fontp (char-displayable-p #10r128274)) + " ✉" + " [direct]")) + ((equal visibility "private") + (if (fontp (char-displayable-p #10r9993)) + " 🔒" + " [followers]"))) + (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 + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description parsed-time) + parsed-time)) + (propertize "\n ------------\n" 'face 'default)) 'favourited-p faved 'boosted-p boosted 'byline t)))) (defun mastodon-tl--format-faved-or-boosted-byline (letter) - "Format the byline marker for a boosted or favorited status. + "Format the byline marker for a boosted or favourited status. LETTER is a string, either F or B." (format "(%s) " (propertize letter 'face 'mastodon-boost-fave-face))) @@ -766,10 +826,11 @@ message is a link which unhides/hides the main body." (or (alist-get 'remote_url media-attachement) ;; fallback b/c notifications don't have remote_url (alist-get 'url media-attachement))) - (type (alist-get 'type media-attachement))) + (type (alist-get 'type media-attachement)) + (caption (alist-get 'description media-attachement))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering - preview-url remote-url type) ; 2nd arg for shr-browse-url + preview-url remote-url type caption) ; 2nd arg for shr-browse-url (concat "Media::" preview-url "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p @@ -791,7 +852,7 @@ Runs `mastodon-tl--render-text' and fetches poll or media." (mastodon-tl--get-poll toot)) (mastodon-tl--media toot)))) -(defun mastodon-tl--insert-status (toot body author-byline action-byline &optional id) +(defun mastodon-tl--insert-status (toot body author-byline action-byline &optional id parent-toot) "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. @@ -804,7 +865,8 @@ takes a single function. By default it is `mastodon-tl--byline-boosted'. ID is that of the toot, which is attached as a property if it is -a notification." +a notification. If the status is a favourite or a boost, +PARENT-TOOT is the JSON of the toot responded to." (let ((start-pos (point))) (insert (propertize @@ -815,7 +877,8 @@ a notification." 'toot-id (or id ; for notifications (alist-get 'id toot)) 'base-toot-id (mastodon-tl--toot-id toot) - 'toot-json toot) + 'toot-json toot + 'parent-toot parent-toot) "\n") (when mastodon-tl--display-media-p (mastodon-media--inline-images start-pos (point))))) @@ -901,11 +964,11 @@ a notification." (let ((attachments (mastodon-tl--property 'attachments)) vids) (mapc (lambda (x) - (let ((att-type (plist-get x :type))) - (when (or (string= "video" att-type) - (string= "gifv" att-type)) - (push x vids)))) - attachments) + (let ((att-type (plist-get x :type))) + (when (or (string= "video" att-type) + (string= "gifv" att-type)) + (push x vids)))) + attachments) (car vids))) (defun mastodon-tl--mpv-play-video-from-byline () @@ -929,7 +992,7 @@ in which case play first video or gif from current toot." (type (or ;; in byline: type ;; point in toot: - (mastodon-tl--property 'mastodon-media-type)))) + (mastodon-tl--property 'mastodon-media-type)))) (if url (if (or (equal type "gifv") (equal type "video")) @@ -1057,7 +1120,6 @@ webapp" (reblog (alist-get 'reblog json))) (if reblog (alist-get 'id reblog) id))) - (defun mastodon-tl--thread () "Open thread buffer for toot under `point'." (interactive) @@ -1089,41 +1151,142 @@ webapp" (mastodon-tl--goto-next-toot)) (message "No Thread!")))) +(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 (equal "" 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) + nil))) + (mastodon-http--triage response + (lambda () + (message "Filter created for %s!" word) + ;; reload if we are in filters view: + (when (string= (mastodon-tl--get-endpoint) + "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 (equal 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))))))) + (defun mastodon-tl--get-follow-suggestions () -"Display a buffer of suggested accounts to follow." + "Display a buffer of suggested accounts to follow." (interactive) - (let* ((buffer (format "*mastodon-follow-suggestions*")) - (response - (mastodon-http--get-json - (mastodon-http--api "suggestions"))) - (users (mapcar 'mastodon-search--get-user-info response))) - (with-output-to-temp-buffer buffer - (let ((inhibit-read-only t)) - (switch-to-buffer buffer) - (mastodon-mode) - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " SUGGESTED ACCOUNTS\n" - " ------------\n\n") - 'success)) - (mastodon-search--insert-users-propertized users :note))))) + (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))) (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. Can be called to toggle NOTIFY on users already being followed." - (interactive - (list - (mastodon-tl--interactive-user-handles-get "follow"))) - (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify)) + (interactive + (list + (mastodon-tl--interactive-user-handles-get "follow"))) + (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (get-text-property (point) 'toot-json))) + (message "Looks like there's no toot or user at point?") + (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify))) (defun mastodon-tl--enable-notify-user-posts (user-handle) "Query for USER-HANDLE and enable notifications when they post." (interactive (list (mastodon-tl--interactive-user-handles-get "enable"))) - (mastodon-tl--follow-user user-handle "true")) + (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (get-text-property (point) 'toot-json))) + (message "Looks like there's no toot or user at point?") + (mastodon-tl--follow-user user-handle "true"))) (defun mastodon-tl--disable-notify-user-posts (user-handle) "Query for USER-HANDLE and disable notifications when they post." @@ -1137,14 +1300,20 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "unfollow"))) - (mastodon-tl--do-user-action-and-response user-handle "unfollow" t)) + (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (get-text-property (point) 'toot-json))) + (message "Looks like there's no toot or user at point?") + (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) (defun mastodon-tl--block-user (user-handle) "Query for USER-HANDLE from current status and block that user." (interactive (list (mastodon-tl--interactive-user-handles-get "block"))) - (mastodon-tl--do-user-action-and-response user-handle "block")) + (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (get-text-property (point) 'toot-json))) + (message "Looks like there's no toot or user at point?") + (mastodon-tl--do-user-action-and-response user-handle "block"))) (defun mastodon-tl--unblock-user (user-handle) "Query for USER-HANDLE from list of blocked users and unblock that user." @@ -1160,7 +1329,10 @@ Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "mute"))) - (mastodon-tl--do-user-action-and-response user-handle "mute")) + (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (get-text-property (point) 'toot-json))) + (message "Looks like there's no toot or user at point?") + (mastodon-tl--do-user-action-and-response user-handle "mute"))) (defun mastodon-tl--unmute-user (user-handle) "Query for USER-HANDLE from list of muted users and unmute that user." @@ -1173,15 +1345,31 @@ Can be called to toggle NOTIFY on users already being followed." (defun mastodon-tl--interactive-user-handles-get (action) "Get the list of user-handles for ACTION from the current toot." - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read (if (or (equal action "disable") - (equal action "enable")) - (format "%s notifications when user posts: " action) - (format "Handle of user to %s: " action)) - user-handles - nil ; predicate - 'confirm))) + (if (and (not (string-prefix-p "accounts" (mastodon-tl--get-endpoint))) ;profile view + (not (get-text-property (point) 'toot-json))) + (message "Looks like there's no toot or user at point?") + (let ((user-handles + (cond ((or (equal (buffer-name) "*mastodon-follow-suggestions*") + ;; follow suggests / search / foll requests compat: + (string-prefix-p "*mastodon-search" (buffer-name)) + (equal (buffer-name) "*mastodon-follow-requests*") + ;; profile view follows/followers compat: + ;; but not for profile statuses: + (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint))))) + ;; avoid tl--property here because it calls next-toot + ;; which breaks non-toot buffers like foll reqs etc.: + (list (alist-get 'acct (get-text-property (point) 'toot-json)))) + (t + (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))))) + (completing-read (if (or (equal action "disable") + (equal action "enable")) + (format "%s notifications when user posts: " action) + (format "Handle of user to %s: " action)) + user-handles + nil ; predicate + 'confirm)))) (defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) "Fetch the list of accounts for ACTION from the server. @@ -1215,7 +1403,9 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json)))) (user-id (mastodon-profile--account-field account 'id)) - (name (mastodon-profile--account-field account 'display_name)) + (name (if (not (equal "" (mastodon-profile--account-field account 'display_name))) + (mastodon-profile--account-field account 'display_name) + (mastodon-profile--account-field account 'username))) (url (mastodon-http--api (if notify (format "accounts/%s/%s?notify=%s" user-id action notify) @@ -1452,16 +1642,21 @@ UPDATE-FUNCTION is used to recieve more toots. JSON is the data returned from the server." (with-output-to-temp-buffer 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. + ;; which means we cannot use buffer-spec for update-function + ;; unless we set it both before and after the others + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,endpoint + update-function ,update-function)) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed mastodon-tl--timestamp-next-update (time-add (current-time) (seconds-to-time 300))) (funcall update-function json)) - (mastodon-tl--goto-next-toot) (mastodon-mode) - (when (equal endpoint "follow_requests") - (mastodon-profile-mode)) (with-current-buffer buffer (setq mastodon-tl--buffer-spec `(buffer-name ,buffer @@ -1475,7 +1670,15 @@ JSON is the data returned from the server." nil ;; don't repeat #'mastodon-tl--update-timestamps-callback (current-buffer) - nil))))) + nil))) + (unless + ;; for everything save profiles: + (string-prefix-p "accounts" endpoint)) + ;;(or (equal endpoint "notifications") + ;; (string-prefix-p "timelines" endpoint) + ;; (string-prefix-p "favourites" endpoint) + ;; (string-prefix-p "statuses" endpoint)) + (mastodon-tl--goto-first-item))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. @@ -1487,6 +1690,14 @@ Runs synchronously." (json (mastodon-http--get-json url))) (with-output-to-temp-buffer 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. + ;; which means we cannot use buffer-spec for update-function + ;; unless we set it both before and after the others + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,endpoint + update-function ,update-function)) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -1507,7 +1718,11 @@ Runs synchronously." nil ;; don't repeat #'mastodon-tl--update-timestamps-callback (current-buffer) - nil)))) + nil))) + (when ;(and (not (equal json '[])) + ;; for everything save profiles: + (not (string-prefix-p "accounts" endpoint)) + (mastodon-tl--goto-first-item))) buffer)) (provide 'mastodon-tl) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 48e7d96..f8d0642 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -48,6 +48,7 @@ (defvar mastodon-instance-url) (defvar mastodon-tl--buffer-spec) +(defvar mastodon-tl--enable-proportional-fonts) (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") @@ -70,6 +71,11 @@ (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-toot "mastodon") +;; for mastodon-toot--translate-toot-text +(autoload 'mastodon-tl--content "mastodon-tl") +(when (require 'lingva nil :no-error) + (declare-function lingva-translate "lingva")) + (defgroup mastodon-toot nil "Tooting in Mastodon." :prefix "mastodon-toot-" @@ -171,9 +177,9 @@ Valid values are \"direct\", \"private\" (followers-only), (alist-get 'statuses (alist-get 'configuration json-response)))))) - (setq mastodon-toot--max-toot-chars max-chars) - (with-current-buffer "*new toot*" - (mastodon-toot--update-status-fields)))) + (setq mastodon-toot--max-toot-chars max-chars) + (with-current-buffer "*new toot*" + (mastodon-toot--update-status-fields)))) (defun mastodon-toot--action-success (marker byline-region remove) "Insert/remove the text MARKER with 'success face in byline. @@ -197,7 +203,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (propertize marker 'face 'success))))) ;; leave point after the marker: (unless remove - (mastodon-tl--goto-next-toot)))) + (mastodon-tl--goto-next-toot)))) (defun mastodon-toot--action (action callback) "Take ACTION on toot at point, then execute CALLBACK. @@ -259,7 +265,7 @@ Makes a POST request to the server." (mastodon-toot--action-success "F" byline-region remove)) (message (format "%s #%s" action id)))) - (message "Nothing to favorite here?!?")))) + (message "Nothing to favourite here?!?")))) (defun mastodon-toot--copy-toot-url () "Copy URL of toot at point." @@ -271,6 +277,30 @@ Makes a POST request to the server." (kill-new url) (message "Toot URL copied to the clipboard."))) +(defun mastodon-toot--copy-toot-text () + "Copy text of toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json))) + (kill-new (mastodon-tl--content toot)) + (message "Toot content copied to the clipboard."))) + +;; (when (require 'lingva nil :no-error) +(defun mastodon-toot--translate-toot-text () + "Translate text of toot at point. +Uses `lingva.el'." + (interactive) + (if (not (require 'lingva nil :no-error)) + (message "Looks like you need to install lingva.el first.") + (if mastodon-tl--buffer-spec + (let ((toot (mastodon-tl--property 'toot-json))) + (if toot + (lingva-translate nil + (mastodon-tl--content toot) + (when mastodon-tl--enable-proportional-fonts + t)) + (message "No toot to translate?"))) + (message "No mastodon buffer?")))) + (defun mastodon-toot--own-toot-p (toot) "Check if TOOT is user's own, e.g. for deleting it." (and (not (alist-get 'reblog toot)) @@ -323,7 +353,7 @@ NO-REDRAFT means delete toot only." (if no-redraft (progn (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) + (mastodon-tl--reload-timeline-or-profile)) (message "Toot deleted!")) (mastodon-toot--redraft response reply-id @@ -492,9 +522,9 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mapcar (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids))) (args (append args-media args-no-media))) (cond ((and mastodon-toot--media-attachments ;; make sure we have media args @@ -593,11 +623,13 @@ candidate ARG. IGNORED remains a mystery." "Reply to toot at `point'." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--field 'id toot))) + (parent (mastodon-tl--property 'parent-toot)) ; for new notifs handling + (id (mastodon-tl--as-string + (mastodon-tl--field 'id (or parent toot)))) (account (mastodon-tl--field 'account toot)) (user (alist-get 'acct account)) - (mentions (mastodon-toot--mentions toot)) - (boosted (mastodon-tl--field 'reblog toot)) + (mentions (mastodon-toot--mentions (or parent toot))) + (boosted (mastodon-tl--field 'reblog (or parent toot))) (booster (when boosted (alist-get 'acct (alist-get 'account toot))))) @@ -606,14 +638,27 @@ candidate ARG. IGNORED remains a mystery." (if (and (not (equal user booster)) (not (string-match booster mentions))) + ;; different booster, user and mentions: (concat (mastodon-toot--process-local user) ;; "@" booster " " - (mastodon-toot--process-local booster) mentions) + (mastodon-toot--process-local booster) + mentions) + ;; booster is either user or in mentions: + (if (not (string-match user mentions)) + ;; user not already in mentions: + (concat (mastodon-toot--process-local user) + mentions) + ;; user already in mentions: + mentions)) + ;; ELSE no booster: + (if (not (string-match user mentions)) + ;; user not in mentions: (concat (mastodon-toot--process-local user) - mentions)) - (concat (mastodon-toot--process-local user) - mentions))) - id toot))) + mentions) + ;; user in mentions already: + mentions))) + id + (or parent toot)))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a52bf41..49abe26 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -1,6 +1,7 @@ ;;; mastodon.el --- Client for Mastodon -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org> ;; Author: Johnson Denen <johnson.denen@gmail.com> ;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> ;; Version: 0.10.0 @@ -85,15 +86,46 @@ (autoload 'mastodon-tl--poll-vote "mastodon-http") ;; (autoload 'mastodon-toot--delete-and-redraft-toot "mastodon-toot") (autoload 'mastodon-profile--view-bookmarks "mastodon-profile") +(autoload 'mastoton-tl--view-filters "mastodon-tl") ;; (autoload 'mastodon-toot--bookmark-toot-toggle "mastodon-toot") +(when (require 'lingva nil :no-error) + (autoload 'mastodon-toot--translate-toot-text "mastodon-toot")) + (defgroup mastodon nil "Interface with Mastodon." :prefix "mastodon-" :group 'external) (defcustom mastodon-instance-url "https://mastodon.social" - "Base URL for the Masto instance from which you toot." + "Base URL for the Mastodon instance you want to be active. + +For example, if your mastodon username is +\"example_user@social.instance.org\", and you want this account +to be active, the value of this variable should be +\"https://social.instance.org\". + +Also for completeness, the value of `mastodon-active-user' should +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 + "Username of the active user. + +For example, if your mastodon username is +\"example_user@social.instance.org\", and you want this account +to be active, the value of this variable should be +\"example_user\". + +Also for completeness, the value of `mastodon-instance-url' +should be \"https://social.instance.org\". + +After setting these variables you should restart Emacs for these +changes to take effect." :group 'mastodon :type 'string) @@ -164,6 +196,10 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "v") #'mastodon-tl--poll-vote) (define-key map (kbd "k") #'mastodon-toot--bookmark-toot-toggle) (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) + (when (require 'lingva nil :no-error) + (define-key map (kbd "s") #'mastodon-toot--translate-toot-text)) map) "Keymap for `mastodon-mode'.") @@ -201,12 +237,17 @@ Use. e.g. \"%c\" for your locale's date and time format." (let* ((tls (list "home" "local" "federated" - (concat (mastodon-auth--user-acct) "-statuses") ; profile + (concat (mastodon-auth--user-acct) "-statuses") ; own profile "favourites" "search")) - (buffer (cl-some (lambda (el) - (get-buffer (concat "*mastodon-" el "*"))) - tls))) ; return first buff that exists + (buffer (or (cl-some (lambda (el) + (get-buffer (concat "*mastodon-" el "*"))) + tls) ; return first buff that exists + (cl-some (lambda (x) + (when + (string-prefix-p "*mastodon-" (buffer-name x)) + (get-buffer x))) + (buffer-list))))) ; catch any other masto buffer (if buffer (switch-to-buffer buffer) (mastodon-tl--get-home-timeline) diff --git a/test/ert-helper.el b/test/ert-helper.el index a6d6692..f65649f 100644 --- a/test/ert-helper.el +++ b/test/ert-helper.el @@ -1,3 +1,4 @@ +(load-file "lisp/mastodon.el") (load-file "lisp/mastodon-search.el") (load-file "lisp/mastodon-async.el") (load-file "lisp/mastodon-http.el") @@ -7,8 +8,8 @@ (load-file "lisp/mastodon-inspect.el") (load-file "lisp/mastodon-media.el") (load-file "lisp/mastodon-notifications.el") +(load-file "lisp/mastodon.el") (load-file "lisp/mastodon-profile.el") (load-file "lisp/mastodon-search.el") (load-file "lisp/mastodon-tl.el") (load-file "lisp/mastodon-toot.el") -(load-file "lisp/mastodon.el") diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index 6a090b7..2d9d6df 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -32,47 +32,6 @@ `(:error "invalid_grant" :error_description ,error-message)) (t error)))))) -(ert-deftest mastodon-auth--generate-token--no-storing-credentials () - "Should make `mastdon-http--post' request to generate auth token." - (with-mock - (let ((mastodon-auth-source-file "") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (read-string "Email: " user-mail-address) => "foo@bar.com") - (mock (read-passwd "Password: ") => "password") - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) - -(ert-deftest mastodon-auth--generate-token--storing-credentials () - "Should make `mastdon-http--post' request to generate auth token." - (with-mock - (let ((mastodon-auth-source-file "~/.authinfo") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (auth-source-search :create t - :host "https://instance.url" - :port 443 - :require '(:user :secret)) - => '((:user "foo@bar.com" :secret (lambda () "password")))) - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) - (ert-deftest mastodon-auth--get-token () "Should generate token and return JSON response." (with-temp-buffer @@ -94,12 +53,23 @@ (ert-deftest mastodon-auth--access-token-not-found () "Should set and return `mastodon-auth--token' if nil." (let ((mastodon-instance-url "https://instance.url") + (mastodon-active-user "user") (mastodon-auth--token-alist nil)) (with-mock (mock (mastodon-auth--get-token) => '(:access_token "foobaz")) + (mock (mastodon-client--store-access-token "foobaz")) + (stub mastodon-client--make-user-active) (should (string= (mastodon-auth--access-token) "foobaz")) (should (equal mastodon-auth--token-alist '(("https://instance.url" . "foobaz"))))))) + +(ert-deftest mastodon-auth--user-unaware () + (let ((mastodon-instance-url "https://instance.url") + (mastodon-active-user nil) + (mastodon-auth--token-alist nil)) + (with-mock + (mock (mastodon-client--active-user)) + (should-error (mastodon-auth--access-token))))) diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el index 9123286..b302ed6 100644 --- a/test/mastodon-client-tests.el +++ b/test/mastodon-client-tests.el @@ -10,7 +10,7 @@ '(("client_name" . "mastodon.el") ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) + ("website" . "https://codeberg.org/martianh/mastodon.el")) nil :unauthenticated)) (mastodon-client--register))) @@ -24,25 +24,22 @@ (current-buffer))) (should (equal (mastodon-client--fetch) '(:foo "bar")))))) -(ert-deftest mastodon-client--store-1 () - "Should return the client plist." +(ert-deftest mastodon-client--store () + "Test the value `mastodon-client--store' returns/stores." (let ((mastodon-instance-url "http://mastodon.example") (plist '(:client_id "id" :client_secret "secret"))) (with-mock (mock (mastodon-client--token-file) => "stubfile.plstore") - (mock (mastodon-client--fetch) => '(:client_id "id" :client_secret "secret")) - (let* ((plstore (plstore-open "stubfile.plstore")) - (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) - (should (equal (mastodon-client--store) plist)))))) - -(ert-deftest mastodon-client--store-2 () - "Should store client in `mastodon-client--token-file'." - (let* ((mastodon-instance-url "http://mastodon.example") - (plstore (plstore-open "stubfile.plstore")) - (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) - (plstore-close plstore) - (should (string= (plist-get client :client_id) "id")) - (should (string= (plist-get client :client_secret) "secret")))) + (mock (mastodon-client--fetch) => plist) + (should (equal (mastodon-client--store) plist))) + (let* ((plstore (plstore-open "stubfile.plstore")) + (client (mastodon-client--remove-key-from-plstore + (plstore-get plstore "mastodon-http://mastodon.example")))) + (plstore-close plstore) + (should (equal client plist)) + ;; clean up - delete the stubfile + (delete-file "stubfile.plstore")))) + (ert-deftest mastodon-client--read-finds-match () "Should return mastodon client from `mastodon-token-file' if it exists." @@ -52,6 +49,27 @@ (should (equal (mastodon-client--read) '(:client_id "id2" :client_secret "secret2")))))) +(ert-deftest mastodon-client--general-read-finds-match () + (with-mock + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--general-read "user-test8000@mastodon.example") + '(:username "test8000@mastodon.example" + :instance "http://mastodon.example" + :client_id "id2" :client_secret "secret2" + :access_token "token2"))))) + +(ert-deftest mastodon-client--general-read-finds-no-match () + (with-mock + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--general-read "nonexistant-key") + nil)))) + +(ert-deftest mastodon-client--general-read-empty-store () + (with-mock + (mock (mastodon-client--token-file) => "fixture/empty.plstore") + (should (equal (mastodon-client--general-read "something") + nil)))) + (ert-deftest mastodon-client--read-finds-no-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.social")) @@ -103,3 +121,54 @@ (should (equal (mastodon-client) '(:client_id "foo" :client_secret "baz"))) (should (equal mastodon-client--client-details-alist '(("http://mastodon.example" :client_id "foo" :client_secret "baz"))))))) + +(ert-deftest mastodon-client--form-user-from-vars () + (let ((mastodon-active-user "test9000") + (mastodon-instance-url "https://mastodon.example")) + (should + (equal (mastodon-client--form-user-from-vars) + "test9000@mastodon.example")))) + +(ert-deftest mastodon-client--current-user-active-p () + (let ((mastodon-active-user "test9000") + (mastodon-instance-url "https://mastodon.example")) + ;; when the current user /is/ the active user + (with-mock + (mock (mastodon-client--general-read "active-user") => '(:username "test9000@mastodon.example" :client_id "id1")) + (should (equal (mastodon-client--current-user-active-p) + '(:username "test9000@mastodon.example" :client_id "id1")))) + ;; when the current user is /not/ the active user + (with-mock + (mock (mastodon-client--general-read "active-user") => '(:username "user@other.example" :client_id "id1")) + (should (null (mastodon-client--current-user-active-p)))))) + +(ert-deftest mastodon-client--store-access-token () + (let ((mastodon-instance-url "https://mastodon.example") + (mastodon-active-user "test8000") + (user-details + '(:username "test8000@mastodon.example" + :instance "https://mastodon.example" + :client_id "id" :client_secret "secret" + :access_token "token"))) + ;; test if mastodon-client--store-access-token /returns/ right + ;; value + (with-mock + (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) + (mock (mastodon-client--token-file) => "stubfile.plstore") + (should (equal (mastodon-client--store-access-token "token") + user-details))) + ;; test if mastodon-client--store-access-token /stores/ right value + (with-mock + (mock (mastodon-client--token-file) => "stubfile.plstore") + (should (equal (mastodon-client--general-read + "user-test8000@mastodon.example") + user-details))) + (delete-file "stubfile.plstore"))) + +(ert-deftest mastodon-client--make-user-active () + (let ((user-details '(:username "test@mastodon.example"))) + (with-mock + (mock (mastodon-client--token-file) => "stubfile.plstore") + (mastodon-client--make-user-active user-details) + (should (equal (mastodon-client--general-read "active-user") + user-details))))) |