+++ /dev/null
-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.
-\1f
-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 fediverse services using the
- Mastodon API.
+++ /dev/null
-;;; mastodon-async.el --- Async streaming functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017 Alex J. Griffith
-;; Author: Alex J. Griffith <griffitajNOSPAMgmail.com>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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:
-
-;; Rework sync code so it does not mess up the async-buffer
-
-;;; Code:
-
-(require 'mastodon-tl)
-(require 'json)
-(require 'url-http)
-
-(defvar url-http-end-of-headers)
-
-(autoload 'mastodon-auth--access-token "mastodon-auth")
-(autoload 'mastodon-http--api "mastodon-http")
-(autoload 'mastodon-http--get-json "mastodon-http")
-(autoload 'mastodon-mode "mastodon")
-(autoload 'mastodon-notifications--timeline "mastodon-notifications")
-(autoload 'mastodon-tl--timeline "mastodon-tl")
-
-(defgroup mastodon-async nil
- "An async module for mastodon streams."
- :prefix "mastodon-async-"
- :group 'external)
-
-;;;###autoload
-(define-minor-mode mastodon-async-mode
- "Async Mastodon."
- :lighter " MasA")
-
-(defvar mastodon-instance-url)
-
-(defvar mastodon-tl--enable-relative-timestamps)
-(defvar mastodon-tl--display-media-p)
-(defvar mastodon-tl--buffer-spec)
-
-(defvar-local mastodon-async--queue "" ;;"*mastodon-async-queue*"
- "The intermediate queue buffer name.")
-
-(defvar-local mastodon-async--buffer "" ;;"*mastodon-async-buffer*"
- "User facing output buffer name.")
-
-(defvar-local mastodon-async--http-buffer "" ;;""
- "Buffer variable bound to http output.")
-
-(defun mastodon-async--display-http ()
- "Display the async HTTP input buffer."
- (display-buffer mastodon-async--http-buffer))
-
-(defun mastodon-async--display-buffer ()
- "Display the async user facing buffer."
- (interactive)
- (display-buffer mastodon-async--buffer))
-
-(defun mastodon-async--display-queue ()
- "Display the async queue buffer."
- (display-buffer mastodon-async--queue))
-
-(defun mastodon-async--stop-http ()
- "Stop the http processs and close the async and http buffer."
- (interactive)
- (let ((inhibit-read-only t))
- (stop-process (get-buffer-process mastodon-async--http-buffer))
- (delete-process (get-buffer-process mastodon-async--http-buffer))
- (kill-buffer mastodon-async--http-buffer)
- (setq mastodon-async--http-buffer "")
- (when (not (string= "" mastodon-async--queue)) ; error handle on kill async buffer
- (kill-buffer mastodon-async--queue))))
-
-(defun mastodon-async--stream-notifications ()
- "Open a stream of user notifications."
- (interactive)
- (mastodon-async--mastodon
- "user"
- "home"
- "notifications"
- 'mastodon-async--process-queue-string-notifications))
-
-(defun mastodon-async--stream-home ()
- "Open a stream of the home timeline."
- (interactive)
- (mastodon-async--mastodon
- "user"
- "home"
- "home"
- 'mastodon-async--process-queue-string))
-
-(defun mastodon-async--stream-federated ()
- "Open a stream of Federated."
- (interactive)
- (mastodon-async--mastodon
- "public"
- "public"
- "federated"
- 'mastodon-async--process-queue-string))
-
-(defun mastodon-async--stream-local ()
- "Open a stream of Local."
- (interactive)
- ;; Need to add another layer of filtering for this to work
- ;; apparently it the local flag does not work
- (mastodon-async--mastodon
- "public"
- "public?local=true"
- "local"
- 'mastodon-async--process-queue-local-string))
-
-(defun mastodon-async--mastodon (endpoint timeline name filter)
- "Make sure that the previous async process has been closed.
-Then start an async stream at ENDPOINT filtering toots
-using FILTER.
-TIMELINE is a specific target, such as federated or home.
-NAME is the center portion of the buffer name for
-*mastodon-async-buffer and *mastodon-async-queue."
- (ignore timeline) ;; TODO: figure out what this is meant to be used for
- (let ((buffer (mastodon-async--start-process
- endpoint filter name)))
- (with-current-buffer buffer
- (mastodon-async--display-buffer)
- (goto-char (point-max))
- (goto-char 1))))
-
-(defun mastodon-async--get (url callback)
- "An async GET request to URL with CALLBACK."
- (let ((url-request-method "GET")
- (url-request-extra-headers
- `(("Authorization" .
- ,(concat
- "Bearer "
- (mastodon-auth--access-token))))))
- (url-retrieve url callback)))
-
-(defun mastodon-async--set-http-buffer (buffer http-buffer)
- "Initialize for BUFFER a local variable `mastodon-async--http-buffer'.
-HTTP-BUFFER is the initializing value. Use this funcion if HTTP-BUFFER
-is not known when `mastodon-async--setup-buffer' is called."
- (with-current-buffer (get-buffer-create buffer)
- (setq mastodon-async--http-buffer http-buffer)))
-
-(defun mastodon-async--set-local-variables (buffer
- http-buffer
- buffer-name
- queue-name)
- "Set local variables for BUFFER, HTTP-BUFFER, BUFFER-NAME, and QUEUE-NAME."
- (with-current-buffer (get-buffer-create buffer)
- (let ((value mastodon-instance-url))
- (make-local-variable 'mastodon-instance-url)
- (setq-local mastodon-instance-url value))
- (setq mastodon-async--http-buffer http-buffer)
- (setq mastodon-async--buffer buffer-name)
- (setq mastodon-async--queue queue-name)))
-
-(defun mastodon-async--setup-http (http-buffer name)
- "Add local variables to HTTP-BUFFER.
-NAME is used to generate the display buffer and the queue."
- (let ((queue-name (concat " *mastodon-async-queue-" name "-"
- mastodon-instance-url "*"))
- (buffer-name (concat "*mastodon-async-display-" name "-"
- mastodon-instance-url "*")))
- (mastodon-async--set-local-variables http-buffer http-buffer
- buffer-name queue-name)))
-
-(defun mastodon-async--setup-queue (http-buffer name)
- "Set up HTTP-BUFFER buffer for the async queue.
-NAME is used to generate the display buffer and the queue."
- (let ((queue-name (concat " *mastodon-async-queue-" name "-"
- mastodon-instance-url "*"))
- (buffer-name(concat "*mastodon-async-display-" name "-"
- mastodon-instance-url "*")))
- (mastodon-async--set-local-variables queue-name http-buffer
- buffer-name queue-name)
- queue-name))
-
-(defun mastodon-async--setup-buffer (http-buffer name endpoint)
- "Set up the buffer timeline like `mastodon-tl--init'.
-HTTP-BUFFER the name of the http-buffer, if unknown, set to...
-NAME is the name of the stream for the buffer name.
-ENDPOINT is the endpoint for the stream and timeline."
- (let ((queue-name (concat " *mastodon-async-queue-" name "-"
- mastodon-instance-url "*"))
- (buffer-name (concat "*mastodon-async-display-" name "-"
- mastodon-instance-url "*"))
- ;; if user stream, we need "timelines/home" not "timelines/user"
- ;; if notifs, we need "notifications" not "timelines/notifications"
- (endpoint (cond
- ((string= name "notifications") "notifications")
- ((string= name "home") "timelines/home")
- (t (format "timelines/%s" endpoint)))))
- (mastodon-async--set-local-variables buffer-name http-buffer
- buffer-name queue-name)
- ;; Similar to timeline init.
- (with-current-buffer (get-buffer-create buffer-name)
- (setq inhibit-read-only t) ; for home timeline?
- (make-local-variable 'mastodon-tl--enable-relative-timestamps)
- (make-local-variable 'mastodon-tl--display-media-p)
- (message (mastodon-http--api endpoint))
- (if (string= name "notifications")
- (mastodon-notifications--timeline
- (mastodon-http--get-json
- (mastodon-http--api "notifications")))
- (mastodon-tl--timeline (mastodon-http--get-json
- (mastodon-http--api endpoint))))
- (mastodon-mode)
- (mastodon-tl--set-buffer-spec buffer-name
- endpoint
- (if (string= 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))))
-
-(defun mastodon-async--start-process (endpoint filter &optional name)
- "Start an async mastodon stream at ENDPOINT.
-Filter the toots using FILTER.
-NAME is used for the queue and display buffer."
- (let* ((stream (concat "streaming/" endpoint))
- (async-queue (mastodon-async--setup-queue "" (or name stream)))
- (async-buffer (mastodon-async--setup-buffer "" (or name stream) endpoint))
- (http-buffer (mastodon-async--get
- (mastodon-http--api stream)
- (lambda (status)
- (ignore status)
- (message "HTTP SOURCE CLOSED")))))
- (mastodon-async--setup-http http-buffer (or name stream))
- (mastodon-async--set-http-buffer async-buffer http-buffer)
- (mastodon-async--set-http-buffer async-queue http-buffer)
- (set-process-filter (get-buffer-process http-buffer)
- (mastodon-async--http-hook filter))
- http-buffer))
-
-(defun mastodon-async--http-hook (filter)
- "Return a lambda with a custom FILTER for processing toots."
- (let ((filter filter))
- (lambda (proc data)
- (with-current-buffer (process-buffer proc)
- (let* ((string
- (mastodon-async--stream-filter
- (mastodon-async--http-layer proc data)))
- (queue-string (mastodon-async--cycle-queue string)))
- (when queue-string
- (mastodon-async--output-toot
- (funcall filter queue-string))))))))
-
-(defun mastodon-async--process-queue-string (string)
- "Parse the output STRING of the queue buffer, returning only update events."
- (let ((split-strings (split-string string "\n" t)))
- (when split-strings ; do nothing if we get nothing; just postpones the error
- (let ((event-type (replace-regexp-in-string
- "^event: " ""
- (car split-strings)))
- (data (replace-regexp-in-string
- "^data: " "" (cadr split-strings))))
- (when (string= "update" event-type)
- ;; in some casses the data is not fully formed
- ;; for now return nil if malformed using `ignore-errors'
- (ignore-errors (json-read-from-string data)))))))
-
-(defun mastodon-async--process-queue-string-notifications (string)
- "Parse the output STRING of the queue buffer, returning only notification events."
- ;; NB notification events in streams include follow requests
- (let* ((split-strings (split-string string "\n" t))
- (event-type (replace-regexp-in-string
- "^event: " ""
- (car split-strings)))
- (data (replace-regexp-in-string
- "^data: " "" (cadr split-strings))))
- (when (string= "notification" event-type)
- ;; in some casses the data is not fully formed
- ;; for now return nil if malformed using `ignore-errors'
- (ignore-errors (json-read-from-string data)))))
-
-(defun mastodon-async--process-queue-local-string (string)
- "Use STRING to limit the public endpoint to displaying local steams only."
- (let ((json (mastodon-async--process-queue-string string)))
- (when json
- (when (mastodon-async--account-local-p json)
- json))))
-
-(defun mastodon-async--account-local-p (json)
- "Test JSON to see if account is local."
- (not (string-match-p
- "@"
- (alist-get 'acct (alist-get 'account json)))))
-
-(defun mastodon-async--output-toot (toot)
- "Process TOOT and prepend it to the async user-facing buffer."
- (if (not (bufferp (get-buffer mastodon-async--buffer)))
- (mastodon-async--stop-http)
- (when toot
- (with-current-buffer mastodon-async--buffer
- (let* ((inhibit-read-only t)
- (old-max (point-max))
- (previous (point))
- (mastodon-tl--enable-relative-timestamps t)
- (mastodon-tl--display-media-p t))
- (goto-char (point-min))
- (if (equal (buffer-name)
- (concat "*mastodon-async-display-notifications-"
- mastodon-instance-url "*"))
- (mastodon-notifications--timeline (list toot))
- (mastodon-tl--timeline (list toot)))
- (if (eq previous 1)
- (goto-char 1)
- (goto-char (+ previous (- (point-max) old-max)))))))))
-
-(defun mastodon-async--cycle-queue (string)
- "Append the most recent STRING from http buffer to queue buffer.
-Then determine if a full message has been recived. If so return it.
-Full messages are seperated by two newlines"
- (with-current-buffer mastodon-async--queue
- (goto-char (max-char))
- (insert (decode-coding-string string 'utf-8))
- (goto-char 0)
- (let ((next (re-search-forward "\n\n" nil t)))
- (when next
- (let ((return-string (buffer-substring 1 next))
- (inhibit-read-only t))
- (delete-region 1 next)
- return-string)))))
-
-(defun mastodon-async--http-layer (proc data)
- "Passes PROC and DATA to ‘url-http-generic-filter’.
-It then processes its output."
- (with-current-buffer (process-buffer proc)
- (let ((start (max 1 (- (point-max) 2))))
- (url-http-generic-filter proc data)
- (when (> url-http-end-of-headers start)
- (setq start url-http-end-of-headers))
- (let ((end (- (point-max) 2)))
- (buffer-substring start end)))))
-
-(defun mastodon-async--stream-filter (string)
- "Remove comments from STRING."
- (replace-regexp-in-string "^:.*\n" "" string))
-
-(provide 'mastodon-async)
-;;; mastodon-async.el ends here
+++ /dev/null
-;;; mastodon-auth.el --- Auth functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2021 Abhiseck Paira <abhiseckpairaNOSPAMdisroot.org>
-;; Copyright (C) 2025 Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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-auth.el supports authorizing and authenticating with Mastodon.
-
-;;; Code:
-
-(require 'plstore)
-(require 'auth-source)
-(require 'json)
-(require 'url)
-
-(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--concat-params-to-url "mastodon-http")
-(autoload 'mastodon-http--get-json "mastodon-http")
-(autoload 'mastodon-http--post "mastodon-http")
-(autoload 'mastodon-return-credential-account "mastodon")
-(autoload 'mastodon-client--general-read "mastodon-client")
-(autoload 'mastodon-client--token-file "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-use-auth-source t
- "Whether to use auth sources for user credentials.
-If t, save and read user access token in the user's auth source
-file (see `auth-sources'). If nil, use `mastodon-client--token-file'
-instead.
-If you change the value of this variable, call
-`mastodon-forget-all-logins' and log in again.
-If for some reason you generate a new token, you'll have to update your
-auth souce file manually, or at least remove the entry and authenticate
-again, as auth-source.el only provides unreliable tools for updating
-entries."
- :type 'boolean)
-
-(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.")
-
-(defvar mastodon-auth--acct-alist nil
- "Alist of account accts (name@domain) keyed by instance url.")
-
-(defvar mastodon-auth--user-unaware
- " ** MASTODON.EL - NOTICE **
-
-User variables not set: mastodon.el requires that you set both
-`mastodon-active-user' and `mastodon-instance-url' in your init file.
-
-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.
-")
-
-(defun mastodon-auth--get-browser-login-url ()
- "Return properly formed browser login url."
- (let ((client-id (plist-get (mastodon-client) :client_id)))
- (if (not client-id)
- (error "Failed to set up client id")
- (mastodon-http--concat-params-to-url
- (concat mastodon-instance-url "/oauth/authorize/")
- `(("response_type" . "code")
- ("redirect_uri" . ,mastodon-client-redirect-uri)
- ("scope" . ,mastodon-client-scopes)
- ("client_id" . ,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.
-By default 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 'below)
- 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))
- (select-enable-clipboard t)
- authorization-code)
- (kill-new url)
- (message "%s" url)
- (setq authorization-code
- (mastodon-auth--show-notice mastodon-auth--explanation
- "*mastodon-notice*"
- "Authorization Code: "))
- authorization-code))
-
-(defun mastodon-auth--generate-token ()
- "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."
- (with-current-buffer (mastodon-auth--generate-token)
- (goto-char (point-min))
- (re-search-forward "^$" nil 'move)
- (let ((json-object-type 'plist)
- (json-key-type 'keyword)
- (json-array-type 'vector)
- (json-string (buffer-substring-no-properties (point) (point-max))))
- (json-read-from-string json-string))))
-
-(defun mastodon-auth--plstore-token-check (&optional auth-source)
- "Signal an error if plstore contains unencrypted access-token.
-If AUTH-SOURCE, and if `mastodon-auth-use-auth-source' is non-nil,
-return non-nil if it contains any access token.
-Used to help users switch to the new encrypted auth token flow."
- ;; FIXME: is it poss to move this plstore read to have one less read?
- ;; e.g. inside of `mastodon-client--active-user'? the issue is that
- ;; ideally we want to test "user-" entry, even if fetching "active-user"
- ;; entry, so we would have to re-do the plstore read functions.
- (when
- (mastodon-auth--plstore-access-token-member auth-source)
- (if auth-source
- (user-error "Auth source storage of tokens is enabled,\
- but there is also an access token in your plstore.\
- If you're seeing this message after updating,\
- call `mastodon-forget-all-logins', and try again.
- If you don't want to use auth sources,\
- also set `mastodon-auth-use-auth-source' to nil.\
- If this message is in error, contact us on the mastodon.el repo")
- (user-error "Unencrypted access token in your plstore.\
- If you're seeing this message after updating,\
- call `mastodon-forget-all-logins', and log in again.
- If this message is in error, contact us on the mastodon.el repo"))))
-
-(defun mastodon-auth--plstore-access-token-member (&optional auth-source)
- "Return non-nil if the user entry of the plstore contains :access_token.
-If AUTH-SOURCE, also check if it contains :secret-access_token."
- (let* ((plstore (plstore-open (mastodon-client--token-file)))
- (name (concat "user-" (mastodon-client--form-user-from-vars)))
- ;; get alist like plstore.el does, so that keys will display with
- ;; ":secret-" prefix if encrypted:
- (alist (assoc name (plstore--get-merged-alist plstore))))
- (if (and auth-source mastodon-auth-use-auth-source)
- (or (member :access_token alist)
- (member :secret-access_token alist))
- (member :access_token alist))))
-
-(defun mastodon-auth--access-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.
- (alist-get mastodon-instance-url
- mastodon-auth--token-alist nil nil #'string=))
- ;; if auth source enabled, but we have an access token in plstore,
- ;; error out and tell user to remove plstore and start over or disable
- ;; auth source:
- ((mastodon-auth--plstore-token-check))
- ((plist-get (mastodon-client--active-user) :access_token)
- ;; user variables need to be read from plstore active-user entry.
- (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 #'string=))
- ((null mastodon-active-user)
- ;; user not aware of 2FA-related changes and has not set
- ;; `mastodon-active-user'. Make user aware and error out.
- (mastodon-auth--show-notice mastodon-auth--user-unaware
- "*mastodon-notice*")
- (user-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'.
-The token is returned by `mastodon-auth--get-token'.
-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)))
- (`(:error ,class :error_description ,error)
- (error "Mastodon-auth--access-token: %s: %s" class error))
- (_ (error "Unknown response from mastodon-auth--get-token!"))))
-
-(defun mastodon-auth-source-get (user host &optional token create)
- "Fetch an auth source token, searching by USER and HOST.
-If CREATE, use TOKEN or prompt for it, and save it if there is no such entry.
-Return a list of user, password/secret, and the item's save-function."
- (let* ((auth-source-creation-prompts
- '((secret . "%u access token: ")))
- (source
- (car
- (auth-source-search :host host :user user
- :require '(:user :secret)
- :secret (if token token nil)
- ;; "create" alone doesn't work here!:
- :create (if create t nil)))))
- (when source
- (let ((creds
- `(,(plist-get source :user)
- ,(auth-info-password source)
- ,(plist-get source :save-function))))
- (when create ;; call save function:
- (when (functionp (nth 2 creds))
- (funcall (nth 2 creds))))
- creds))))
-
-(defun mastodon-auth-source-token (url handle &optional token create)
- "Parse URL, search auth sources with it, user HANDLE and TOKEN.
-Calls `mastodon-auth-source-get', returns only the token.
-If CREATE, create an entry is none is found."
- (let ((host (url-host
- (url-generic-parse-url url)))
- (username (car (split-string handle "@"))))
- (nth 1
- (mastodon-auth-source-get username host token create))))
-
-(defun mastodon-auth--get-account-name ()
- "Request user credentials and return an account name."
- (alist-get 'acct
- (mastodon-return-credential-account)))
-
-(defun mastodon-auth--get-account-id ()
- "Request user credentials and return an account name."
- (alist-get 'id
- (mastodon-return-credential-account)))
-
-(defun mastodon-auth--user-acct ()
- "Return a mastodon user acct name."
- (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist))
- (let ((acct (mastodon-auth--get-account-name)))
- (push (cons mastodon-instance-url acct) mastodon-auth--acct-alist)
- acct)))
-
-(provide 'mastodon-auth)
-;;; mastodon-auth.el ends here
+++ /dev/null
-;;; mastodon-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
-;; Generated by the `loaddefs-generate' function.
-
-;; This file is part of GNU Emacs.
-
-;;; Code:
-
-(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
-
-
-\f
-;;; Generated autoloads from mastodon.el
-
-(autoload 'mastodon-forget-all-logins "mastodon" "\
-Delete `mastodon-client--token-file'.
-Also nil `mastodon-auth--token-alist'." t)
-(autoload 'mastodon "mastodon" "\
-Connect client to `mastodon-instance-url' instance.
-If there are any open mastodon.el buffers, switch to one instead.
-Prority in switching is given to timeline views." t)
-(autoload 'mastodon-toot "mastodon" "\
-Update instance with new toot. Content is captured in a new buffer.
-If USER is non-nil, insert after @ symbol to begin new toot.
-If REPLY-TO-ID is non-nil, attach new toot to a conversation.
-If REPLY-JSON is the json of the toot being replied to.
-
-(fn &optional USER REPLY-TO-ID REPLY-JSON)" t)
-(autoload 'mastodon-notifications-get "mastodon" "\
-Display NOTIFICATIONS in buffer.
-Optionally only print notifications of type TYPE, a string.
-BUFFER-NAME is added to \"*mastodon-\" to create the buffer name.
-MAX-ID is a request parameter for pagination.
-
-(fn &optional TYPE BUFFER-NAME MAX-ID)" t)
-(autoload 'mastodon-url-lookup "mastodon" "\
-If a URL resembles a fediverse link, try to load in `mastodon.el'.
-Does a WebFinger lookup on the server.
-URL can be arg QUERY-URL, or URL at point, or provided by the user.
-If a status or account is found, load it in `mastodon.el', if
-not, just browse the URL in the normal fashion.
-If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'.
-
-(fn &optional QUERY-URL FORCE)" t)
-(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
-(register-definition-prefixes "mastodon" '("mastodon-"))
-
-\f
-;;; Generated autoloads from mastodon-async.el
-
-(autoload 'mastodon-async-mode "mastodon-async" "\
-Async Mastodon.
-
-This is a minor mode. If called interactively, toggle the
-`Mastodon-Async mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the mode
-if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate the variable `mastodon-async-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-(fn &optional ARG)" t)
-(register-definition-prefixes "mastodon-async" '("mastodon-async--"))
-
-\f
-;;; Generated autoloads from mastodon-auth.el
-
-(register-definition-prefixes "mastodon-auth" '("mastodon-auth-"))
-
-\f
-;;; Generated autoloads from mastodon-client.el
-
-(register-definition-prefixes "mastodon-client" '("mastodon-client"))
-
-\f
-;;; Generated autoloads from mastodon-discover.el
-
-(register-definition-prefixes "mastodon-discover" '("mastodon-discover"))
-
-\f
-;;; Generated autoloads from mastodon-http.el
-
-(register-definition-prefixes "mastodon-http" '("mastodon-http--"))
-
-\f
-;;; Generated autoloads from mastodon-inspect.el
-
-(register-definition-prefixes "mastodon-inspect" '("mastodon-inspect--"))
-
-\f
-;;; Generated autoloads from mastodon-iso.el
-
-(register-definition-prefixes "mastodon-iso" '("mastodon-iso-639-"))
-
-\f
-;;; Generated autoloads from mastodon-media.el
-
-(register-definition-prefixes "mastodon-media" '("mastodon-media--"))
-
-\f
-;;; Generated autoloads from mastodon-notifications.el
-
-(register-definition-prefixes "mastodon-notifications" '("mastodon-"))
-
-\f
-;;; Generated autoloads from mastodon-profile.el
-
-(register-definition-prefixes "mastodon-profile" '("mastodon-profile-"))
-
-\f
-;;; Generated autoloads from mastodon-search.el
-
-(register-definition-prefixes "mastodon-search" '("mastodon-search-"))
-
-\f
-;;; Generated autoloads from mastodon-tl.el
-
-(register-definition-prefixes "mastodon-tl" '("mastodon-" "with-mastodon-buffer"))
-
-\f
-;;; Generated autoloads from mastodon-toot.el
-
-(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe)
-(register-definition-prefixes "mastodon-toot" '("mastodon-t"))
-
-\f
-;;; Generated autoloads from mastodon-transient.el
-
-(register-definition-prefixes "mastodon-transient" '("mastodon-"))
-
-\f
-;;; Generated autoloads from mastodon-views.el
-
-(autoload 'mastodon-views-view-scheduled-toots "mastodon-views" "\
-Show the user's scheduled toots in a new buffer." t)
-(autoload 'mastodon-views-view-filters "mastodon-views" "\
-View the user's filters in a new buffer." t)
-(register-definition-prefixes "mastodon-views" '("mastodon-views-"))
-
-\f
-;;; Generated autoloads from mastodon-widget.el
-
-(register-definition-prefixes "mastodon-widget" '("mastodon-widget-"))
-\f
-;;; End of scraped data
-
-(provide 'mastodon-autoloads)
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; no-native-compile: t
-;; coding: utf-8-emacs-unix
-;; End:
-
-;;; mastodon-autoloads.el ends here
+++ /dev/null
-;;; mastodon-client.el --- Client functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2021 Abhiseck Paira <abhiseckpairaNOSPAMdisroot.org>
-;; Copyright (C) 2025 Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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-client.el supports registering the Emacs client with your Mastodon instance.
-
-;;; Code:
-
-(require 'plstore)
-(require 'json)
-(require 'url)
-
-(defvar mastodon-instance-url)
-(defvar mastodon-active-user)
-(defvar mastodon-auth-use-auth-source)
-
-(autoload 'mastodon-http--api "mastodon-http")
-(autoload 'mastodon-http--post "mastodon-http")
-(autoload 'mastodon-auth-source-token "mastodon-auth")
-
-(defcustom mastodon-client--token-file
- (concat user-emacs-directory "mastodon.plstore")
- "File path where Mastodon access tokens are stored."
- :group 'mastodon
- :type 'file)
-
-(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" . ,mastodon-client-redirect-uri)
- ("scopes" . ,mastodon-client-scopes)
- ("website" . ,mastodon-client-website))
- nil
- :unauthenticated))
-
-(defun mastodon-client--fetch ()
- "Return JSON from `mastodon-client--register' call."
- (let ((buf (mastodon-client--register)))
- (if (not buf)
- (user-error "Client registration failed.\
- Is `mastodon-instance-url' correct?")
- (with-current-buffer buf
- (goto-char (point-min))
- (re-search-forward "^$" nil 'move)
- (let* ((json-object-type 'plist)
- (json-key-type 'keyword)
- (json-array-type 'vector)
- (json-string
- (buffer-substring-no-properties (point) (point-max)))
- (parsed
- (json-read-from-string json-string)))
- (if (eq :error (car parsed))
- (error "Error: %s" (cadr parsed))
- parsed))))))
-
-(defun mastodon-client--token-file ()
- "Return `mastodon-client--token-file'."
- mastodon-client--token-file)
-
-(defun mastodon-client--store ()
- "Store client_id and client_secret in `mastodon-client--token-file'.
-Make `mastodon-client--fetch' call to determine client values.
-Return a plist of secret and non-secret key/val pairs."
- (let* ((plstore (plstore-open (mastodon-client--token-file)))
- (client (mastodon-client--fetch))
- (secrets `( :client_id ,(plist-get client :client_id)
- :client_secret ,(plist-get client :client_secret)))
- (sans-secrets
- (dolist (x '(:client_id :client_secret) client)
- (cl-remf client x)))
- ;; alexgriffith reported seeing ellipses in the saved output
- ;; which indicate some output truncating. Nothing in
- ;; `plstore-save' seems to ensure this cannot happen so let's do
- ;; that ourselves:
- (print-length nil)
- (print-level nil))
- (plstore-put plstore
- (concat "mastodon-" mastodon-instance-url)
- sans-secrets secrets)
- ;; FIXME: breaks tests: prompts for gpg passphrase
- (plstore-save plstore)
- (plstore-close plstore)
- (append secrets sans-secrets)))
-
-(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))))
- (plstore-close plstore)
- (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)))
- (plstore-close plstore)
- (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 encrypted in the plstore.
-Return the plist after the operation.
-If `mastodon-auth-use-auth-source', encrypt it in auth source file."
- (let* ((user-details (mastodon-client--make-user-details-plist))
- (plstore (plstore-open (mastodon-client--token-file)))
- (username (mastodon-client--form-user-from-vars))
- (key (concat "user-" username))
- (secrets `( :client_id ,(plist-get user-details :client_id)
- :client_secret ,(plist-get user-details :client_secret)))
- (sans-secrets
- (dolist (x '(:client_id :client_secret) user-details)
- (cl-remf user-details x)))
- (print-length nil)
- (print-level nil))
- (if mastodon-auth-use-auth-source
- ;; auth-source:
- (progn
- (mastodon-auth-source-token
- mastodon-instance-url username token :create)
- (plstore-put plstore key sans-secrets secrets))
- ;; plstore encrypted:
- (plstore-put plstore key sans-secrets
- (append secrets `(:access_token ,token))))
- (plstore-save plstore)
- (plstore-close plstore)
- (cdr (plstore-get plstore key))))
-
-(defun mastodon-client--make-user-active (user-details)
- "USER-DETAILS is a plist consisting of user details.
-Save it to plstore under key \"active-user\".
-If `mastodon-auth-use-auth-source' is non-nil, fetch the access token
-from the user's auth source file and add it to the active user entry.
-Return a plist of secret and non-secret key/val pairs."
- (let* ((plstore (plstore-open (mastodon-client--token-file)))
- (handle (plist-get user-details :username))
- (token
- (if mastodon-auth-use-auth-source
- (mastodon-auth-source-token mastodon-instance-url handle)
- (plist-get user-details :access_token)))
- (secrets `( :access_token ,token
- :client_id ,(plist-get user-details :client_id)
- :client_secret ,(plist-get user-details :client_secret)))
- (deets (copy-sequence user-details))
- (sans-secrets
- (dolist (x '(:client_id :client_secret :access_token) deets)
- (cl-remf deets x)))
- (print-length nil)
- (print-level nil))
- (plstore-put plstore "active-user" sans-secrets secrets)
- (plstore-save plstore)
- (plstore-close plstore)
- (append secrets sans-secrets)))
-
-(defun mastodon-client--form-user-from-vars ()
- "Create a username from user variable. Return that username.
-Username in the form userNOSPAMinstance.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 (mastodon-client--general-read
- (concat "user-" username))))
- (when user-plist
- (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
- (string= (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."
- (or mastodon-client--active-user-details-plist
- (setq mastodon-client--active-user-details-plist
- (or (mastodon-client--current-user-active-p)
- (mastodon-client--make-current-user-active)))))
-
-(defun mastodon-client ()
- "Return variable client secrets to use for `mastodon-instance-url'.
-If `mastodon-client--client-details-alist' is nil, read plist from
-`mastodon-client--token-file'.
-Fetch and store plist if `mastodon-client--read' returns nil.
-Return a plist."
- (let ((client-details
- (cdr (assoc mastodon-instance-url
- mastodon-client--client-details-alist))))
- (or client-details
- (let ((client-details (or (mastodon-client--read)
- (mastodon-client--store))))
- (push (cons mastodon-instance-url client-details)
- mastodon-client--client-details-alist)
- client-details))))
-
-(provide 'mastodon-client)
-;;; mastodon-client.el ends here
-
+++ /dev/null
-;;; mastodon-discover.el --- Use Mastodon.el with discover.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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:
-
-;; This adds optional functionality that can be used if the dicover package
-;; is present.
-;;
-;; See the README file for how to use this.
-
-;;; Code:
-
-(declare-function discover-add-context-menu "discover")
-
-(autoload 'mastodon-kill-window "mastodon")
-
-(defun mastodon-discover ()
- "Plug Mastodon functionality into `discover'."
- (interactive)
- (when (require 'discover nil :noerror)
- (discover-add-context-menu
- :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-toggle-bookmark)
- ("v" "Vote on poll" mastodon-tl-poll-vote)
- ("n" "Next" mastodon-tl-goto-next-item)
- ("p" "Prev" mastodon-tl-goto-prev-item)
- ("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)
- ("o" "Open toot URL" mastodon-toot-browse-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)
- ("'" "Followed tags timeline" mastodon-tl-followed-tags-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)
- ("g/u" "Update timeline" mastodon-tl-update)
- ("s" "Search" mastodon-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." mastodon--kill-window)
- ("M-C-q" "Quit mastodon and kill all buffers." mastodon-kill-all-buffers)))))))
-
-(provide 'mastodon-discover)
-;;; mastodon-discover.el ends here
+++ /dev/null
-;;; mastodon-http.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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-http.el provides HTTP request/response functions.
-
-;;; Code:
-
-(require 'json)
-(require 'url)
-(require 'url-http)
-(require 'shr)
-
-(defvar mastodon-instance-url)
-(defvar mastodon-toot--media-attachment-ids)
-(defvar mastodon-toot--media-attachment-filenames)
-
-(autoload 'mastodon-auth--access-token "mastodon-auth")
-(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
-(autoload 'url-insert "url-handlers")
-
-(defvar mastodon-http--api-version "v1")
-
-(defconst mastodon-http--timeout 15
- "HTTP request timeout, in seconds. Has no effect on Emacs < 26.1.")
-
-(defun mastodon-http--api (endpoint &optional version)
- "Return Mastodon API URL for ENDPOINT.
-Optionally specify VERSION in format vX."
- (concat mastodon-instance-url "/api/"
- (or version mastodon-http--api-version) "/" endpoint))
-
-(defun mastodon-http--api-v2 (endpoint)
- "Return Mastodon API v2 URL for ENDPOINT."
- (mastodon-http--api endpoint "v2"))
-
-(defun mastodon-http--url-retrieve-synchronously (url &optional silent)
- "Retrieve URL asynchronously.
-This is a thin abstraction over the system
-`url-retrieve-synchronously'. Depending on which version of this
-is available we will call it with or without a timeout.
-SILENT means don't message."
- (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
- (url-retrieve-synchronously url)
- (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout)))
-
-(defun mastodon-http--response-status (resp)
- "Return the status code from RESP, a response buffer."
- ;; `url-http-parse-response' breaks tests, as
- ;; `url-http-end-of-headers' not set, so we roll our own:
- (with-current-buffer resp
- (goto-char (point-min))
- (skip-chars-forward " \t\n") ; Skip any blank crap
- (skip-chars-forward "/HPT0-9.") ; Skip HTTP Version "HTTP/X.Y"
- (read (current-buffer))))
-
-(defun mastodon-http--triage (response success)
- "Determine if RESPONSE was successful.
-Call SUCCESS on RESPONSE if successful. Message status and JSON error
-from RESPONSE if unsuccessful."
- (let ((status (mastodon-http--response-status response)))
- (if (and (>= 200 status)
- (<= status 299))
- ;; (string-prefix-p "2" (number-to-string status))
- (funcall success response)
- (if (= 404 status)
- (message "Error %s: page not found" status)
- (let ((json-response (with-current-buffer response
- (mastodon-http--process-json))))
- (message "Error %s: %s" status (alist-get 'error json-response)))))))
-
-(defun mastodon-http--read-file-as-string (filename &optional url)
- "Read a file FILENAME as a string.
-Used to generate image preview.
-URL means FILENAME is a URL."
- (with-temp-buffer
- (if url
- (url-insert-file-contents filename)
- (insert-file-contents filename))
- (string-to-unibyte (buffer-string))))
-
-(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p)
- "Make a METHOD type request using BODY, with Mastodon authorization.
-Unless UNAUTHENTICATED-P is non-nil."
- (declare (debug 'body)
- (indent 1))
- `(let ((url-request-method ,method)
- (url-request-extra-headers
- (unless ,unauthenticated-p
- (list (cons "Authorization"
- (concat "Bearer " (mastodon-auth--access-token)))))))
- ,body))
-
-(defun mastodon-http--build-params-string (params)
- "Build a request parameters string from parameters alist PARAMS."
- ;; (url-build-query-string args nil))
- ;; url-build-query-string adds 'nil' for empty params so lets stick with our
- ;; own:
- (mapconcat (lambda (p)
- (when (cdr p) ; only when value
- (concat (url-hexify-string (car p))
- "=" (url-hexify-string (cdr p)))))
- params "&"))
-
-(defun mastodon-http--build-array-params-alist (param-str array)
- "Return parameters alist using PARAM-STR and ARRAY param values.
-Used for API form data parameters that take an array."
- (cl-loop for x in array
- collect (cons param-str x)))
-
-(defun mastodon-http--concat-params-to-url (url params)
- "Build a query string with PARAMS and concat to URL."
- (if params
- (concat url "?"
- (mastodon-http--build-params-string params))
- url))
-
-(defun mastodon-http--post (url
- &optional params headers unauthenticated-p json)
- "POST synchronously to URL, optionally with PARAMS and HEADERS.
-Authorization header is included by default unless
-UNAUTHENTICATED-P is non-nil.
-If JSON is :json, encode PARAMS as JSON for
-the request data. If it is :raw, just use the plain params."
- ;; NB: raw is used by `mastodon-tl-unfilter-user-languages'; not sure if
- ;; there's a way around it?
- (mastodon-http--authorized-request "POST"
- (let* ((url-request-data
- (when params
- (cond ((eq json :json)
- (json-encode params))
- ((eq json :raw)
- params)
- (t
- (mastodon-http--build-params-string params)))))
- (url-request-extra-headers
- (append url-request-extra-headers ; auth set in macro
- (if json
- '(("Content-Type" . "application/json")
- ("Accept" . "application/json"))
- (unless (assoc "Content-Type" headers) ; pleroma compat:
- '(("Content-Type" . "application/x-www-form-urlencoded"))))
- headers)))
- (with-temp-buffer
- (mastodon-http--url-retrieve-synchronously url)))
- unauthenticated-p))
-
-(defun mastodon-http--get (url &optional params silent)
- "Make synchronous GET request to URL.
-PARAMS is an alist of any extra parameters to send with the request.
-SILENT means don't message."
- (mastodon-http--authorized-request "GET"
- ;; url-request-data doesn't seem to work with GET requests?:
- (let ((url (mastodon-http--concat-params-to-url url params)))
- (mastodon-http--url-retrieve-synchronously url silent))))
-
-(defun mastodon-http--get-response (url &optional params no-headers silent vector)
- "Make synchronous GET request to URL. Return JSON and response headers.
-PARAMS is an alist of any extra parameters to send with the request.
-SILENT means don't message.
-NO-HEADERS means don't collect http response headers.
-VECTOR means return json arrays as vectors."
- (let ((buf (mastodon-http--get url params silent)))
- ;; --get can return nil if instance unresponsive:
- (if (not buf)
- (user-error "Looks like the server response borked. \
-Is your instance up?")
- (with-current-buffer buf
- (mastodon-http--process-response no-headers vector)))))
-
-(defun mastodon-http--get-json (url &optional params silent vector)
- "Return only JSON data from URL request.
-PARAMS is an alist of any extra parameters to send with the request.
-SILENT means don't message.
-VECTOR means return json arrays as vectors."
- (car (mastodon-http--get-response url params :no-headers silent vector)))
-
-(defun mastodon-http--process-json ()
- "Return only JSON data from async URL request.
-Callback to `mastodon-http--get-json-async', usually
-`mastodon-tl--init*', is run on the result."
- (car (mastodon-http--process-response :no-headers)))
-
-(defun mastodon-http--render-html-err (string)
- "Render STRING as HTML in a temp buffer.
-STRING should be a HTML for a 404 errror."
- (with-temp-buffer
- (insert string)
- (shr-render-buffer (current-buffer))
- (view-mode))) ; for 'q' to kill buffer and window
- ;; (error ""))) ; stop subsequent processing
-
-(defun mastodon-http--process-response (&optional no-headers vector)
- "Process http response.
-Return a cons of JSON list and http response headers.
-If NO-HEADERS is non-nil, just return the JSON.
-VECTOR means return json arrays as vectors.
-Callback to `mastodon-http--get-response-async', usually
-`mastodon-tl--init*', is run on the result."
- ;; view raw response:
- ;; (switch-to-buffer (current-buffer))
- (let ((headers (unless no-headers
- (mastodon-http--process-headers))))
- (goto-char (point-min))
- (re-search-forward "^$" nil 'move)
- (let ((json-array-type (if vector 'vector 'list))
- (json-string (string-trim-right
- (decode-coding-string
- (buffer-substring-no-properties (point) (point-max))
- 'utf-8))))
- (kill-buffer)
- (cond ((or (string-empty-p json-string) (null json-string))
- nil)
- ;; if we get html, just render it and error:
- ;; ideally we should handle the status code in here rather than
- ;; this crappy hack?
- ((string-prefix-p "\n<" json-string) ; html hack
- ;; NB: in this case, process-response returns t!:
- (mastodon-http--render-html-err json-string)
- nil) ;; return nil instead of t
- ;; if no json or html, maybe we have a plain string error message
- ;; (misskey does this, but there are probably better ways to do
- ;; this):
- ((not (or (string-prefix-p "\n{" json-string)
- (string-prefix-p "\n[" json-string)))
- (error "%s" json-string))
- (t
- ;; instance may return error in JSON e.g. ((error . "Record not
- ;; found")) for a null endpoint. but we don't error here because
- ;; sometimes we just want to check for such an error in an
- ;; if/cond.
- `(,(json-read-from-string json-string) . ,headers))))))
-
-(defun mastodon-http--process-headers ()
- "Return an alist of http response headers."
- (goto-char (point-min))
- (let* ((head-str (buffer-substring-no-properties
- (point-min)
- (re-search-forward "^$" nil 'move)))
- (head-list (split-string head-str "\n")))
- (mapcar (lambda (x)
- (let ((list (split-string x ": ")))
- (cons (car list) (cadr list))))
- head-list)))
-
-(defun mastodon-http--delete (url &optional params)
- "Make DELETE request to URL.
-PARAMS is an alist of any extra parameters to send with the request."
- ;; url-request-data only works with POST requests?
- (let ((url (mastodon-http--concat-params-to-url url params)))
- (mastodon-http--authorized-request "DELETE"
- (with-temp-buffer
- (mastodon-http--url-retrieve-synchronously url)))))
-
-(defun mastodon-http--put (url &optional params headers)
- "Make PUT request to URL.
-PARAMS is an alist of any extra parameters to send with the request.
-HEADERS is an alist of any extra headers to send with the request."
- (mastodon-http--authorized-request "PUT"
- (let ((url-request-data
- (when params (mastodon-http--build-params-string params)))
- (url-request-extra-headers
- (append url-request-extra-headers ; auth set in macro
- (unless (assoc "Content-Type" headers) ; pleroma compat:
- '(("Content-Type" . "application/x-www-form-urlencoded")))
- headers)))
- (with-temp-buffer (mastodon-http--url-retrieve-synchronously url)))))
-
-;; profile update functions
-
-(defun mastodon-http--patch-json (url &optional params)
- "Make synchronous PATCH request to URL. Return JSON response.
-Optionally specify the PARAMS to send."
- (with-current-buffer (mastodon-http--patch url params)
- (mastodon-http--process-json)))
-
-(defun mastodon-http--patch (url &optional params json)
- "Make synchronous PATCH request to URL.
-Optionally specify the PARAMS to send.
-JSON means send params as JSON data."
- (mastodon-http--authorized-request "PATCH"
- ;; NB: unlike POST, PATCHing only works if we use query params!
- ;; so here, unless JSON arg, we use query params and do not set
- ;; `url-request-data'. this is probably an error, i don't understand it.
- (let* ((url-request-data
- (when (and params json)
- (encode-coding-string
- (json-encode params) 'utf-8)))
- ;; (mastodon-http--build-params-string params))))
- (url (if (not json)
- (mastodon-http--concat-params-to-url url params)
- url))
- (headers (when json
- '(("Content-Type" . "application/json")
- ("Accept" . "application/json"))))
- (url-request-extra-headers
- (append url-request-extra-headers headers)))
- (mastodon-http--url-retrieve-synchronously url))))
-
-\f ;; Asynchronous functions
-
-(defun mastodon-http--get-async (url &optional params callback &rest cbargs)
- "Make GET request to URL.
-Pass response buffer to CALLBACK function with args CBARGS.
-PARAMS is an alist of any extra parameters to send with the request."
- (let ((url (mastodon-http--concat-params-to-url url params)))
- (mastodon-http--authorized-request "GET"
- (url-retrieve url callback cbargs))))
-
-(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs)
- "Make GET request to URL. Call CALLBACK with http response and CBARGS.
-PARAMS is an alist of any extra parameters to send with the request."
- (mastodon-http--get-async
- url
- params
- (lambda (status)
- (when status ; for flakey servers
- (apply callback (mastodon-http--process-response) cbargs)))))
-
-(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs)
- "Make GET request to URL. Call CALLBACK with json-list and CBARGS.
-PARAMS is an alist of any extra parameters to send with the request."
- (mastodon-http--get-async
- url
- params
- (lambda (status)
- (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)
- "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."
- (mastodon-http--authorized-request "POST"
- (let ((url-request-data (when params
- (mastodon-http--build-params-string params))))
- (with-temp-buffer
- (url-retrieve url callback cbargs)))))
-
-(defun mastodon-http--get-cb-data (status)
- "Return data using `json-read' after a successful async request.
-If STATUS includes an error, emit a message describing it and return nil."
- (let* ((buf (current-buffer))
- (data (with-temp-buffer
- (url-insert buf)
- (goto-char (point-min))
- (json-read))))
- (if-let* ((error-thrown (plist-get status :error)))
- ;; not necessarily a user error, but we want its functionality:
- (user-error "%S %s" error-thrown (alist-get 'error data))
- data)))
-
-(defun mastodon-http--post-media-callback (status file caption buffer)
- "Callback function called after posting FILE as an attachment with CAPTION.
-The toot is being composed in BUFFER. See `url-retrieve' for STATUS."
- (unwind-protect
- (when-let* ((data (mastodon-http--get-cb-data status)))
- (with-current-buffer buffer
- (let ((id (alist-get 'id data)))
- ;; update ids:
- (if (not mastodon-toot--media-attachment-ids)
- ;; add first id:
- (push id mastodon-toot--media-attachment-ids)
- ;; add new id to end of list to preserve order:
- (push id (cdr
- (last mastodon-toot--media-attachment-ids))))
- ;; pleroma, PUT the description:
- ;; this is how the mangane akkoma web client does it
- ;; and it seems easier than the other options!
- (when (and caption
- (not (string= caption (alist-get 'description data))))
- (let ((url (mastodon-http--api (format "media/%s" id))))
- ;; (message "PUTting image description")
- (mastodon-http--put url `(("description" . ,caption)))))
- (message "Uploading %s... (done)" file)
- (mastodon-toot--update-status-fields))))
- (kill-buffer (current-buffer))))
-
-(defun mastodon-http--post-media-prep-file (filename)
- "Return the request data to upload FILENAME."
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-literally filename)
- (let ((boundary (buffer-hash)))
- (goto-char (point-min))
- (insert "--" boundary "\r\n"
- (format "Content-Disposition: form-data; name=\"file\"; filename=\"%s\"\r\n\r\n"
- (file-name-nondirectory filename)))
- (goto-char (point-max))
- (insert "\r\n" "--" boundary "--" "\r\n")
- `(,boundary . ,(buffer-substring-no-properties (point-min) (point-max))))))
-
-(defun mastodon-http--post-media-attachment (url filename caption)
- "Make POST request to upload FILENAME with CAPTION to the server's media URL.
-The upload is asynchronous. On succeeding,
-`mastodon-toot--media-attachment-ids' is set to the id(s) of the
-item uploaded, and `mastodon-toot--update-status-fields' is run."
- (mastodon-http--authorized-request "POST"
- (let* ((data (mastodon-http--post-media-prep-file filename))
- (url-request-extra-headers
- (append url-request-extra-headers ; auth set in macro
- `(("Content-Type" . ,(format "multipart/form-data; boundary=%s"
- (car data))))))
- (url-request-data (cdr data))
- (params `(("description" . ,caption)))
- (url (mastodon-http--concat-params-to-url url params)))
- (url-retrieve url #'mastodon-http--post-media-callback
- `(,filename ,caption ,(current-buffer))))))
-
-(provide 'mastodon-http)
-;;; mastodon-http.el ends here
+++ /dev/null
-;;; mastodon-inspect.el --- Client for Mastodon -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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:
-
-;; Some tools to help inspect / debug mastodon.el
-
-;;; Code:
-(autoload 'mastodon-http--api "mastodon-http")
-(autoload 'mastodon-http--get-json "mastodon-http")
-(autoload 'mastodon-http--get-search-json "mastodon-http")
-(autoload 'mastodon-media--inline-images "mastodon-media")
-(autoload 'mastodon-mode "mastodon")
-(autoload 'mastodon-tl--as-string "mastodon-tl")
-(autoload 'mastodon-tl--property "mastodon-tl")
-(autoload 'mastodon-tl--toot "mastodon-tl")
-
-(defvar mastodon-instance-url)
-
-(defgroup mastodon-inspect nil
- "Tools to help inspect toots."
- :prefix "mastodon-inspect-"
- :group 'external)
-
-(defun mastodon-inspect--dump-json-in-buffer (name json)
- "Buffer NAME is opened and JSON in printed into it."
- (switch-to-buffer-other-window name)
- (erase-buffer)
- (let ((print-level nil)
- (print-length nil))
- (insert (pp json t)))
- (goto-char (point-min))
- (emacs-lisp-mode)
- (message "success"))
-
-(defun mastodon-inspect--toot ()
- "Find next toot and dump its meta data into new buffer."
- (interactive)
- (mastodon-inspect--dump-json-in-buffer
- (concat "*mastodon-inspect-toot-"
- (mastodon-tl--as-string (mastodon-tl--property 'item-id))
- "*")
- (mastodon-tl--property 'item-json)))
-
-(defun mastodon-inspect--download-single-toot (item-id)
- "Download the toot/status represented by ITEM-ID."
- (mastodon-http--get-json
- (mastodon-http--api (concat "statuses/" item-id))))
-
-(defun mastodon-inspect--view-single-toot (item-id)
- "View the toot/status represented by ITEM-ID."
- (interactive "s Toot ID: ")
- (let ((buffer (get-buffer-create (concat "*mastodon-status-" item-id "*"))))
- (with-current-buffer buffer
- (let ((toot (mastodon-inspect--download-single-toot item-id )))
- (mastodon-tl--toot toot)
- (goto-char (point-min))
- (while (search-forward "\n\n\n | " nil t)
- (replace-match "\n | "))
- (mastodon-media--inline-images (point-min) (point-max))))
- (switch-to-buffer-other-window buffer)
- (mastodon-mode)))
-
-(defun mastodon-inspect--view-single-toot-source (item-id)
- "View the ess source of a toot/status represented by ITEM-ID."
- (interactive "s Toot ID: ")
- (mastodon-inspect--dump-json-in-buffer
- (concat "*mastodon-status-raw-" item-id "*")
- (mastodon-inspect--download-single-toot item-id)))
-
-
-(defvar mastodon-inspect--search-query-accounts-result)
-(defvar mastodon-inspect--single-account-json)
-
-(defvar mastodon-inspect--search-query-full-result)
-(defvar mastodon-inspect--search-result-tags)
-
-(defun mastodon-inspect--get-search-result (query)
- "Inspect function for a search result for QUERY."
- (interactive)
- (setq mastodon-inspect--search-query-full-result
- (append ; convert vector to list
- (mastodon-http--get-search-json
- (format "%s/api/v2/search" mastodon-instance-url)
- query)
- nil))
- (setq mastodon-inspect--search-result-tags
- (append (cdr
- (caddr mastodon-inspect--search-query-full-result))
- nil)))
-
-(defun mastodon-inspect--get-search-account (query)
- "Return JSON for a single account after search QUERY."
- (interactive)
- (setq mastodon-inspect--search-query-accounts-result
- (append ; convert vector to list
- (mastodon-http--get-search-json
- (format "%s/api/v1/accounts/search" mastodon-instance-url)
- query)
- nil))
- (setq mastodon-inspect--single-account-json
- (car mastodon-inspect--search-query-accounts-result)))
-
-
-(provide 'mastodon-inspect)
-;;; mastodon-inspect.el ends here
+++ /dev/null
-;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022 Marty Hiatt
-;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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:
-
-;;; Code:
-
-;; via
-;; https://github.com/VyrCossont/mastodon/blob/0836f4a656d5486784cadfd7d0cd717bb67ede4c/app/helpers/languages_helper.rb
-;; and
-;; https://github.com/Shinmera/language-codes/blob/master/data/iso-639-3.lisp
-
-(defvar mastodon-iso-639-1
- '(("Abkhazian" . "ab")
- ("Afar" . "aa")
- ("Afrikaans" . "af")
- ("Akan" . "ak")
- ("Albanian" . "sq")
- ("Amharic" . "am")
- ("Arabic" . "ar")
- ("Aragonese" . "an")
- ("Armenian" . "hy")
- ("Assamese" . "as")
- ("Avaric" . "av")
- ("Avestan" . "ae")
- ("Aymara" . "ay")
- ("Azerbaijani" . "az")
- ("Bambara" . "bm")
- ("Bashkir" . "ba")
- ("Basque" . "eu")
- ("Belarusian" . "be")
- ("Bengali" . "bn")
- ("Bihari languages" . "bh")
- ("Bislama" . "bi")
- ("Bosnian" . "bs")
- ("Breton" . "br")
- ("Bulgarian" . "bg")
- ("Burmese" . "my")
- ("Central Khmer" . "km")
- ("Chamorro" . "ch")
- ("Chechen" . "ce")
- ("Chinese" . "zh")
- ("Chuvash" . "cv")
- ("Cornish" . "kw")
- ("Corsican" . "co")
- ("Cree" . "cr")
- ("Croatian" . "hr")
- ("Czech" . "cs")
- ("Danish" . "da")
- ("Dzongkha" . "dz")
- ("English" . "en")
- ("Esperanto" . "eo")
- ("Estonian" . "et")
- ("Ewe" . "ee")
- ("Faroese" . "fo")
- ("Fijian" . "fj")
- ("Finnish" . "fi")
- ("Dutch" . "nl")
- ("French" . "fr")
- ("Fulah" . "ff")
- ("Galician" . "gl")
- ("Ganda" . "lg")
- ("Georgian" . "ka")
- ("German" . "de")
- ("Greek" . "el")
- ("Guarani" . "gn")
- ("Gujarati" . "gu")
- ("Haitian" . "ht")
- ("Hausa" . "ha")
- ("Hebrew" . "he")
- ("Herero" . "hz")
- ("Hindi" . "hi")
- ("Hiri Motu" . "ho")
- ("Hungarian" . "hu")
- ("Icelandic" . "is")
- ("Ido" . "io")
- ("Igbo" . "ig")
- ("Indonesian" . "id")
- ("Interlingua" . "ia")
- ("Inuktitut" . "iu")
- ("Inupiaq" . "ik")
- ("Irish" . "ga")
- ("Italian" . "it")
- ("Japanese" . "ja")
- ("Japanese" . "jp")
- ("Javanese" . "jv")
- ("Kalaallisut" . "kl")
- ("Kannada" . "kn")
- ("Kanuri" . "kr")
- ("Kashmiri" . "ks")
- ("Kazakh" . "kk")
- ("Kikuyu" . "ki")
- ("Kinyarwanda" . "rw")
- ("Komi" . "kv")
- ("Kongo" . "kg")
- ("Korean" . "ko")
- ("Kurdish" . "ku")
- ("Kuanyama" . "kj")
- ("Kirghiz" . "ky")
- ("Lao" . "lo")
- ("Latin" . "la")
- ("Latvian" . "lv")
- ("Limburgan" . "li")
- ("Lingala" . "ln")
- ("Lithuanian" . "lt")
- ("Luba-Katanga" . "lu")
- ("Luxembourgish" . "lb")
- ("Macedonian" . "mk")
- ("Malagasy" . "mg")
- ("Malay" . "ms")
- ("Malayalam" . "ml")
- ("Divehi" . "dv")
- ("Maltese" . "mt")
- ("Manx" . "gv")
- ("Maori" . "mi")
- ("Marathi" . "mr")
- ("Marshallese" . "mh")
- ("Mongolian" . "mn")
- ("Nauru" . "na")
- ("Navajo" . "nv")
- ("Ndonga" . "ng")
- ("Nepali" . "ne")
- ("Ndebele, North" . "nd")
- ("Northern Sami" . "se")
- ("Norwegian" . "no")
- ("Bokmål, Norwegian" . "nb")
- ("Chichewa" . "ny")
- ("Norwegian Nynorsk" . "nn")
- ("Interlingue" . "ie")
- ("Occitan" . "oc")
- ("Ojibwa" . "oj")
- ("Church Slavic" . "cu")
- ("Oriya" . "or")
- ("Oromo" . "om")
- ("Ossetian" . "os")
- ("Pali" . "pi")
- ("Persian" . "fa")
- ("Polish" . "pl")
- ("Portuguese" . "pt")
- ("Panjabi" . "pa")
- ("Pushto" . "ps")
- ("Quechua" . "qu")
- ("Romanian" . "ro")
- ("Romansh" . "rm")
- ("Rundi" . "rn")
- ("Russian" . "ru")
- ("Samoan" . "sm")
- ("Sango" . "sg")
- ("Sanskrit" . "sa")
- ("Sardinian" . "sc")
- ("Gaelic" . "gd")
- ("Serbian" . "sr")
- ("Shona" . "sn")
- ("Sichuan Yi" . "ii")
- ("Sindhi" . "sd")
- ("Sinhala" . "si")
- ("Slovak" . "sk")
- ("Slovenian" . "sl")
- ("Somali" . "so")
- ("Sotho, Southern" . "st")
- ("Ndebele, South" . "nr")
- ("Spanish" . "es")
- ("Sundanese" . "su")
- ("Swahili" . "sw")
- ("Swati" . "ss")
- ("Swedish" . "sv")
- ("Tagalog" . "tl")
- ("Tahitian" . "ty")
- ("Tajik" . "tg")
- ("Tamil" . "ta")
- ("Tatar" . "tt")
- ("Telugu" . "te")
- ("Thai" . "th")
- ("Tibetan" . "bo")
- ("Tigrinya" . "ti")
- ("Tonga (Tonga Islands)" . "to")
- ("Tsonga" . "ts")
- ("Tswana" . "tn")
- ("Turkish" . "tr")
- ("Turkmen" . "tk")
- ("Twi" . "tw")
- ("Ukrainian" . "uk")
- ("Urdu" . "ur")
- ("Uighur" . "ug")
- ("Uzbek" . "uz")
- ("Catalan" . "ca")
- ("Venda" . "ve")
- ("Vietnamese" . "vi")
- ("Volapük" . "vo")
- ("Walloon" . "wa")
- ("Welsh" . "cy")
- ("Western Frisian" . "fy")
- ("Wolof" . "wo")
- ("Xhosa" . "xh")
- ("Yiddish" . "yi")
- ("Yoruba" . "yo")
- ("Zhuang" . "za")
- ("Zulu" . "zu")))
-
-;; web UI doesn't respect these for now
-(defvar mastodon-iso-639-regional
- '(("es-AR" "Español (Argentina)")
- ("es-MX" "Español (México)")
- ("pt-BR" "Português (Brasil)")
- ("pt-PT" "Português (Portugal)")
- ("sr-Latn" "Srpski (latinica)")
- ("zh-CN" "简体中文")
- ("zh-HK" "繁體中文（香港）")
- ("zh-TW" "繁體中文（臺灣）")))
-
-(defvar mastodon-iso-639-3
- '(("ast" "Asturian" "Asturianu")
- ("ckb" "Sorani (Kurdish)" "سۆرانی")
- ("jbo" "Lojban" "la .lojban.")
- ("kab" "Kabyle" "Taqbaylit")
- ("kmr" "Kurmanji (Kurdish)" "Kurmancî")
- ("ldn" "Láadan" "Láadan")
- ("lfn" "Lingua Franca Nova" "lingua franca nova")
- ("tok" "Toki Pona" "toki pona")
- ("zba" "Balaibalan" "باليبلن")
- ("zgh" "Standard Moroccan Tamazight" "ⵜⴰⵎⴰⵣⵉⵖⵜ")))
-
-(provide 'mastodon-iso)
-;;; mastodon-iso.el ends here
+++ /dev/null
-;;; mastodon-media.el --- Functions for inlining Mastodon media -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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-media.el provides functions for inlining media.
-
-;; Known bug gnutls -12 when trying to access images on some systems.
-;; It looks like their may be a version mismatch between the encryption
-;; required by the server and client.
-
-;;; Code:
-(require 'url-cache)
-(require 'mm-decode)
-(require 'image-mode)
-
-(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl")
-(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
-(autoload 'mastodon-image-mode "mastodon-tl")
-
-(defvar url-show-status)
-
-(defvar mastodon-tl--shr-image-map-replacement)
-
-(defgroup mastodon-media nil
- "Inline Mastadon media."
- :prefix "mastodon-media-"
- :group 'mastodon)
-
-(defcustom mastodon-media--avatar-height 20
- "Height of the user avatar images (if shown)."
- :type 'integer)
-
-(defcustom mastodon-media--preview-max-height 250
- "Max height of any media attachment preview to be shown in timelines."
- :type 'integer)
-
-(defcustom mastodon-media--enable-image-caching nil
- "Whether images should be cached."
- :type 'boolean)
-
-(defcustom mastodon-media--hide-sensitive-media t
- "Whether media marked as sensitive should be hidden."
- :type 'boolean)
-
-(defvar mastodon-media--generic-avatar-data
- (base64-decode-string
- "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
-B3RJTUUH4QUIFCg2lVD1hwAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAcGSURB
-VHja7dzdT1J/HAfwcw7EQzMKW0pGRMK4qdRZbdrs6aIRbt506V1b/AV1U2td9l9UXnmhW6vgwuko
-SbcOD/a0RB4CCRCRg0AIR4Hz8LvgN2cKCMI5wOH7uXBuugO+eH8+fM/3HIFpmoZAVVYIIABYAAtg
-ASyABbAAAcACWAALYAEsgAUIABbAAlgAC2ABLEAAsAAWwAJYAAtgAQKAxUjxm+R50DRN0zRFUf+8
-kggCwzAMwwDrfyOSJGmattlsdrvd5XLlcrndnyoUir6+vpGRkZMnT/J4vIarwY26MaTAZLVap6en
-fT7f9vY2QRA7Ozv/vJJ8vkgk4vP5XV1dWq1Wq9VKpdIGkjUGi6IoFEWnp6ddLlcymSRJsvzv83g8
-kUikUCi0Wq1Opzt16lS7YBEE8ebNG6PRiGHYoUwHyW7cuPHo0SOlUsl9LIIgXrx4Ybfb//79e7Qj
-CIXC3t7ex48fX7lyhctYBSkURTOZTC3H4fF4SqXy6dOnLHuxh0VR1PPnz2uX2uv17Nmzy5cvc21R
-StP0q1ev7HZ7XaQgCCJJ0u/3T0xMBINBrmGhKGo0Go88p0p5Wa1Wg8GQSqW4g0XT9NTUFIZhdT9y
-Npudn59nLVwIO7FyuVxVrRIqr1AoZDab2QkXG1hTU1PJZJKhg5MkOT8/HwqFuIBF07TP52MoVrvh
-YqLHG4BlsVi2t7cZfQiSJB0OBwudyDiWzWYjCILpR1lZWeECltPp3LeXwEQFg8FoNNryWPl8noVp
-ws6jgG1lgAWwuI914cIFPp/xnX6ZTCYSiVoeq7+/n4U/Q61Wy+Xylse6desWC8kaGBiQSCQtjyWR
-SGQyGY/HY+4hpFJpV1cXRwa8TqdjtBOHh4fVajVHsLRarVKpZChcUqn07t27LPQgS1gSiUSn04nF
-4rofGYbh4eHhgYEBTq2ztFrtyMhI3ZtRo9GMjY2xEyv2sCQSiV6vV6lUdWzGzs7O8fHxwcFBDq7g
-5XL5kydPent76+LV2dmp1+vv37/P5gqe7SvSDofj5cuXteydwjAslUr1ev2DBw9YPt1pwL0ODodj
-YmLCYrEcYZ8LhmGNRjM+Ps5yphqGBUFQKBQyGo0mk2l1dTWfz5MkSVFUPp8/+GSEQiEMw8eOHYNh
-uLu7e2hoaGxsjM05tbfYvpkNx/FQKBSJRCAI6unpwTBsbW0tmUwWbtc6mCMEQSAIOn78+Llz586f
-P9/T05PL5QKBgEKh4GyyCkZfvnwJhULhcHhzczOTyRRuYMtms/l8PpPJZDKZnZ2dvc9HIBCIxeIT
-J04Uvil87ejoOH36tEwm02g0V69evXjxIkewCkZer/fr16+/f/+OxWKlrvQQBEEQxL7dYQRBhEJh
-0fNwBEHEYrFMJlOpVP39/RqNhgU1prAKTDMzMy6XKxqNJhIJptY+CHLmzBmZTHbp0qXbt2+rVKpW
-wtplWl5eDofDTF803Bs0tVrNKFmdsXAcn52dnZ2dDQaD7DAVJRsdHb1z507dT93rhoXj+MrKytzc
-3NLSEnNNVyHZ2bNnr127NjQ0NDg4WEey+mDhOP7u3bu5ubkyI5z9iMnl8nv37o2OjgoEgmbBisVi
-r1+/ttlsjQ1UmYg9fPiwo6OjwVg4jn///v3Dhw/Ly8vNEKiiXhKJpK+vT6fT1d6S/FqkUBSdnJz0
-+/1QsxZFUclkEkXReDxOkuT169dr8TpisnAcN5lMb9++ZfP+11pKIBAUdgpv3rx55BGGtIMUBEG5
-XM7tdhsMhoWFhb3/S8UsVitK1curaqzV1dX379+3nNQ+r42NjSPsPlaH5fP5mnyiV+Ll9XonJyfD
-4XC1XkhVDTgzM/Pz50+oxSubzX779u3z58/VLneQyqUMBsOnT5+acz1V7XoiHo9//PjRZDKl0+n6
-Y3k8HrPZ3Gxr9Fq81tfXl5aWAoFA5cO+IqxIJFLYSIA4VARBuN3uxcXFyoc9v5IGNJvNVquVAw14
-sBktFkt3d7dUKq3k5BGpJFYLCwucacCizZhIJCoJF3JorBYXF//8+QNxtAiCKFwiqKRvkEPnOoqi
-HGvAfeFKJBIVTnqkfKx+/PjBsbleKlwej6cmLI/H43A4OByr3XClUimn03louMphra2teb1eqA0q
-m836fL6tra0jYkUiEb/fz8k3waLhikQiXq+3/NtiSayNjY1fv35BbVP5fN7pdG5tbR0Fy+12c360
-Hxzz5a8KI6V6EMMwzo/2fZ2YTqej0WgqlSoVLqRUDwYCAajNiqKoYDBYphOLY8ViscItVG1VJEmu
-r6+XeU8sjhWPxzc3N9sNiyAIDMOqS1YbDqwKx1YRrFQqxc7HJDRnpdPpUuEqgoVhWL0+i6hFz6tL
-ja3iM4u1zw1qwhlfJihI0bfCNhxYe4NSqg3/A862hQAbrdtHAAAAAElFTkSuQmCC")
- "The PNG data for a generic 100x100 avatar.")
-
-(defvar mastodon-media--generic-broken-image-data
- (base64-decode-string
- "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
-B3RJTUUH4QUIFQUVFt+0LQAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAdoSURB
-VHja7d1NSFRrAIfx//iB6ZDSMJYVkWEk0ceYFUkkhhQlEUhEg0FlC1eBoRTUwlbRok0TgRQURZAE
-FgpjJmFajpK4kggxpXHRQEGWUJZizpy7uPfC5eKiV+dD5zw/mN05jrxnnjnfcxyWZVkCMKc0SXI4
-HIwEMIcUhgAgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCAAgQAEAhAIQCAAgQA2kBaNP8Jt7ViM
-onErOWsQgEAAAgEIBCAQgEAAAgEIBCAQgEAAEAhAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAA
-AgEIBCAQgEAAAgEIBACBAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgECAxSyNIYitz58/
-a3BwUIODgxoZGVEoFFIoFNK3b980NTWlX79+SZIyMzOVlZWlVatWae3atSooKJDH49HOnTvl8XiU
-ksJ3WSI4LMuyHA7Hgv6IZVmM5D8mJyf1/PlzdXZ2qrOzU8FgcMF/0+126+DBg6qqqlJFRYXS0vhe
-+6MP9wI/1wQSJeFwWH6/X01NTWpra9PU1FTM3isvL0/nz5/XuXPntHz5ciqIcSCy/v50L+hlV+Pj
-49a1a9esdevWLXgMTV8ul8u6c+eOFYlELMwtKmNNIOa+fv1qXbp0yXI6nXEP4/+v0tJS6+PHj9RA
-IIk3PT1tXb161crOzk54GP995ebmWt3d3RRBIInj9/utgoKCRRXGf18ZGRmW3++niigHwk56PHf4
-Yiw9PV0dHR0qLy9nD52jWAQylxUrVmhgYEAbN24kkCgsM84+JZmJiQmdPn1akUiEweBE4eL/NsrN
-zVVZWZlKSkpUWFioTZs2yeVyKTs7W7Ozs5qYmNDExITev3+v/v5+9fX1qb+/f8FjevPmTdXW1rIG
-IZDFN9gbNmyQ1+uV1+uVx+MxXlAjIyNqbGzU3bt39fPnz3n9vytXrlQwGJTT6SQQThQm/ohIamqq
-VVlZaXV1dUXtPT98+GCVlZXNe7n4fD6OYnGYN7GDnZ6ebtXU1FhjY2Mxed9IJGLV19fPa7kUFRUR
-CIEkZrAdDod15syZmIXxf7W1tfNaNqOjowSygBdHseZh7969GhgY0IMHD5Sfnx+X97xx44Z2795t
-PF93dzcLjMO88TvHcP/+ffX19WnXrl3xXVApKbp9+7bxfSFv3rxhwRFI7B07dkxDQ0Oqrq5O2P9Q
-XFysffv2Gc0zOjrKwiOQ2Hv69Kny8vIS/n8cP37caPqxsTEWHoHYa//HxPfv3xk0ArGP1atXG03/
-7z3vIBBbyM3NNZo+KyuLQSMQ+5icnDSaPicnh0EjEPsYHh42mp7L3gnEVnp6eoymLyoqYtAIxD4e
-PXpkNP3+/fsZtAXgcvclpL29XUeOHPnj6Z1Op8bHx7Vs2TJ7fri5o9A+ZmZmdPHiRaN5vF6vbeNg
-E8tmGhoaNDQ0ZPTteeHCBQaOQJLfkydPdP36daN5Tp48qc2bNzN47IMkt9evX+vw4cOanp7+43ly
-cnI0PDy8KK4dYx8EMRMIBHT06FGjOCTJ5/PZPg42sZJce3u7Dh06pB8/fhjNV11dndBL8tnEYhMr
-5lpaWuT1evX792+j+YqLixUIBLj+ik2s5NXc3KwTJ04Yx5Gfn69nz54RB5tYyaupqUlVVVWanZ01
-ms/tdqujo4P9DgJJXg8fPtSpU6cUDoeN43j58qUKCwsZRAJJTvfu3dPZs2eNf0/X7Xarq6tL27dv
-ZxAJJDn5fD7V1NQYx7FmzRq9evVK27ZtYxAJJDk1NDSorq7O+ChgQUGBent7tWXLFgYxxniecILU
-1dXJ5/MZz7d161a9ePHC+N50sAZZMq5cuTKvOEpKStTT00McccSJwji7devWvJ7bceDAAbW2ttr6
-cQbGH26eD7K0BAIBlZeXG5/nqKioUEtLizIyMhhEAklOX758kcfj0adPn4zXHG1tbcSRoEDYB4mT
-y5cvG8exZ88etba2Egf7IMnt7du32rFjh9G5jvz8fA0MDBj/UBxYgyw5jY2NRnGkpqaqubmZOBYB
-AomxmZkZPX782Gie+vr6uD9/BGxiJURvb69KS0v/ePrMzEyFQiG5XC4Gj02s5BcIBIymr6ysJA42
-sezj3bt3RtObPv8DBLKkBYNBo+m5r4NAbCUUChlNv379egaNQOzD9FdJ2P8gEFsxfQQaFyMuLhzm
-jfUAG45tOBw2fhY6ojP2rEGWwiqdONjEAggEIBCAQAACAUAgAIEA0cIPx8UYJ1FZgwAEAhAIAAIB
-CAQgEIBAAAIBFiNOFMaY6V1tnFhkDQIQCEAgAIEABAKAQAACAQgEIBCAQAACAQgEIBCAQABIXO4e
-c1y+zhoEIBCAQAAQCEAgAIEABAIQCEAgAIEABAIQCEAgAAgEIBCAQAACAQgEIBCAQAACAQgEAIEA
-BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA
-fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=")
- "The PNG data for a generic 200x200 \"broken image\" view.")
-
-(defvar mastodon-media--sensitive-image-data
- (base64-decode-string
- "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAA6npUWHRSYXcgcHJvZmlsZSB0eXBl
-IGV4aWYAAHjajVHbjcQwCPx3FVcCr/hRjvOSroMtfyc2Ts4rrXRIxjAQPEzC8fo9w89lkiXYknIs
-MRLMihWpCDJ1W5tnsuabbaPGMx7uggBS3NrTIo4fwBGz58X7efSPQSPgimh5CrU6vs746gMlfw5y
-Bsr9Zdr9Ax+k4oxsXi2WnKbV9o1my88xTRKXyMngTSilWBBnIUvQc7+InpuUNmjpgt7AyEergJMc
-ykrwqtZZ6nVMK+7YvAU0skMMb9qFJ/xKUADz4g9VusX8q82j0Rf7z1rhDfqGdxgpcULlAAABhWlD
-Q1BJQ0MgcHJvZmlsZQAAeJx9kT1Iw0AcxV8/tKJVBzuIOGSoTnZREd1qFYpQIdQKrTqYXPohNGlI
-UlwcBdeCgx+LVQcXZ10dXAVB8APE2cFJ0UVK/F9SaBHjwXE/3t173L0D/PUyU81gHFA1y0gnE0I2
-tyKEXtGJIHowgz6JmfqsKKbgOb7u4ePrXYxneZ/7c/QqeZMBPoE4znTDIl4nntq0dM77xBFWkhTi
-c+Ixgy5I/Mh12eU3zkWH/TwzYmTSc8QRYqHYxnIbs5KhEk8SRxVVo3x/1mWF8xZntVxlzXvyF4bz
-2vIS12kOI4kFLEKEABlVbKAMCzFaNVJMpGk/4eEfcvwiuWRybYCRYx4VqJAcP/gf/O7WLEyMu0nh
-BNDxYtsfI0BoF2jUbPv72LYbJ0DgGbjSWv5KHZj+JL3W0qJHQP82cHHd0uQ94HIHGHzSJUNypABN
-f6EAvJ/RN+WAgVuge9XtrbmP0wcgQ12lboCDQ2C0SNlrHu/uau/t3zPN/n4Ag31yra/8+kkAAA14
-aVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8P3hwYWNrZXQgYmVnaW49Iu+7vyIgaWQ9Ilc1TTBN
-cENlaGlIenJlU3pOVGN6a2M5ZCI/Pgo8eDp4bXBtZXRhIHhtbG5zOng9ImFkb2JlOm5zOm1ldGEv
-IiB4OnhtcHRrPSJYTVAgQ29yZSA0LjQuMC1FeGl2MiI+CiA8cmRmOlJERiB4bWxuczpyZGY9Imh0
-dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogIDxyZGY6RGVzY3Jp
-cHRpb24gcmRmOmFib3V0PSIiCiAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94
-YXAvMS4wL21tLyIKICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
-c1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2Vs
-ZW1lbnRzLzEuMS8iCiAgICB4bWxuczpHSU1QPSJodHRwOi8vd3d3LmdpbXAub3JnL3htcC8iCiAg
-ICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht
-cD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgeG1wTU06RG9jdW1lbnRJRD0iZ2lt
-cDpkb2NpZDpnaW1wOmYyYjU4MzUwLTc3ZWMtNDAxNC1hNDVlLTE1N2QyZjljOGM5NyIKICAgeG1w
-TU06SW5zdGFuY2VJRD0ieG1wLmlpZDowOTk5MzZhMi1jOGM5LTRkYTAtYTI0Yi02YTM1MmUyNmNi
-NmUiCiAgIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDphMDliYmZhMi03MzA2LTQ3
-NWQtOGExNC05YzA3ZTE1NmFiMTYiCiAgIGRjOkZvcm1hdD0iaW1hZ2UvcG5nIgogICBHSU1QOkFQ
-ST0iMi4wIgogICBHSU1QOlBsYXRmb3JtPSJMaW51eCIKICAgR0lNUDpUaW1lU3RhbXA9IjE3MTc1
-MDI1MDIzNDQ1NzIiCiAgIEdJTVA6VmVyc2lvbj0iMi4xMC4zNCIKICAgdGlmZjpPcmllbnRhdGlv
-bj0iMSIKICAgeG1wOkNyZWF0b3JUb29sPSJHSU1QIDIuMTAiCiAgIHhtcDpNZXRhZGF0YURhdGU9
-IjIwMjQ6MDY6MDRUMTQ6MDE6NDArMDI6MDAiCiAgIHhtcDpNb2RpZnlEYXRlPSIyMDI0OjA2OjA0
-VDE0OjAxOjQwKzAyOjAwIj4KICAgPHhtcE1NOkhpc3Rvcnk+CiAgICA8cmRmOlNlcT4KICAgICA8
-cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0ic2F2ZWQiCiAgICAgIHN0RXZ0OmNoYW5nZWQ9Ii8i
-CiAgICAgIHN0RXZ0Omluc3RhbmNlSUQ9InhtcC5paWQ6NTRmM2I5NDktOTlkMS00Mzk2LWI2NzIt
-Y2ZkYjRlZWFiYTA1IgogICAgICBzdEV2dDpzb2Z0d2FyZUFnZW50PSJHaW1wIDIuMTAgKExpbnV4
-KSIKICAgICAgc3RFdnQ6d2hlbj0iMjAyNC0wNi0wNFQxNDowMTo0MiswMjowMCIvPgogICAgPC9y
-ZGY6U2VxPgogICA8L3htcE1NOkhpc3Rvcnk+CiAgPC9yZGY6RGVzY3JpcHRpb24+CiA8L3JkZjpS
-REY+CjwveDp4bXBtZXRhPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAg
-ICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6w3d0DAAAABmJLR0QA/wD/AP+gvaeTAAAA
-CXBIWXMAAC4jAAAuIwF4pT92AAAAB3RJTUUH6AYEDAEq/VtQSwAAABl0RVh0Q29tbWVudABDcmVh
-dGVkIHdpdGggR0lNUFeBDhcAAAtOSURBVHja7dvbT5R3Hsfxz5xwhtOsjkgFGQZRTlFOCjJSkpVe
-YFltmpZNuo3t9qLdu/4Pa/+L3jVZL9pEU2q7aGirEkUkWw+IM5SpOELxgICcUXjmsBfKBOooo2Za
-3H2/Ei+EeRif74/3c5gnmj47fDgqAHGZGQFAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEI
-BCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgEAAAgEIBCAQgEAAAgFA
-IACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEIBCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAjw
-CrIm+w0ikYiCwaB8Pp8GBweVk5OjoqIiOZ1OjY+Pq6qq6g8fwuLiov7d1qbFhQUdOHhQaampSd0O
-BBLT2dmp8+fP6/3331dzc7Oi0ahu3bql1tZW7dixY00MIRqNKhQKyWyxyPQ7bAcCkSSNjY3p7Nmz
-anzjDeXl5cW+7vF41NLSos7OzjUxhHXr1umvLS2/23bgHkSSNDk5+ahC65Md5uTkaMuyaID/u0BS
-UlIkSd0XLmhubu6J73vr6tb8gO7fv69gMMhvyhqfV7LeN6mBZGdnKysrS1NTU2r95htNTU29Uou9
-uLiojo4OhUIhfvPX8LyS+b6mzw4fjibzHz8+Pq6jx45pfGxMqamp+suBA9pWWCiTKf5tbSgU0vXr
-1+X3+3Xnzh1t2bJFFRUV8ng8kqSBgQF99dVXkiTXxo36xyefaGBgQD6/X0ODg8rNzVVdXZ1ycnJW
-DNDn86nv55/1YH5excXF8nq9slgsikajmpiY0PDwsPx+v5qbm5WZmamJiQmdOHlSN4NB2Ww2paWn
-a252Vk1NTSovL3/qdsePH1dfX5/WrVsnm82mSCSiAwcOqKCgQF1dXeru7pbNZpNhGCoqKlJzc3NC
-+53oJW0gEND1gQGNjY4qNzdXZWVlKikpic07EolocHBQgUBAwWBQVqtVnoICFW3frry8vNjrnnfO
-q80rWeub6Pu+KMu+ffv+mcxAUlNTVVxUpLm5Od2+fVt+n0/z8/PavHlz7BJsiWEYOnXqlDwej6qr
-q1VVVaUHDx+qtbVVm7KztdHlktPp1I4dOxQIBDQ5OSmTySSXy6Vd1dWqrKxU8OZNnTl9Wrt27Yrd
-+5w5c0YOh0NvNDYqPz9f7e3tqq6ultVq1YMHD+T3+3X+/HmNjIyourpaDodDDodDmzZt0uXLl/XO
-O+9o//79qq+vV3Z2tiQ9dbvCwkLl5ubqypUrcjqd+vjjj+VyuSRJW7ZsUVlZmX755Rft3r1bDQ0N
-MpvNCe33avoDAXV0dKi2pkY1u3erpLRU83Nz8vv9Ki4ultVq1eLiotrb2zU8PKz6+nrt3btXZWVl
-j87wra0yDENut1tms/m557zavJK1vom875q9xFqSkZGhgwcP6t1335XdbtelS5f0xRdf6N69eyte
-19PTo/T0dL322muyWCxKSUlRdVWVcnJzdaKtTXNzc7JYLHK5XMrKypLNZtOePXvkdrtjw6qsqJBh
-GLo3Oho7e3R3dys9I0MWi0UbN25UQ0ODotFoLOC6ujo1NDQ8eXp9fDQ1m81xw4+3ndVqVWFhocrL
-y3Xv3r0V914mk0l2u102m01VVVWyWCwJ7/ezDA0N6djRo3pz/365XC6ZzWb9yenU66+/rg8++EB2
-u12SdOHCBQUCATU1NWnDhg2yWCxKTU1VbW2tGhsb1d3drf/89NOjI+dzznm1eSVrfRN53zX7Me+K
-Es1mFRcXKycnR6dOnZLP59OXX36pjz76SJmZmVpYWNCPP/6ocDisjo6OuD/jRjConY+fnVgsltiQ
-l3M4HLEj/NLrsrOz9e3x42ppaZHb7Y77cNJifbFRPG276upqXb16VYFAQLW1tbGvDwwMaE9dXezs
-9rz7/VuRSEQ//PCDamtrtWHDhqf+O2dmZnTu3DnVeb1KS0t74vuVlZU6e/asTp86pfKdO2OvSXTO
-q0nW+ibb7xbI8rNJc3OzZDLJd+2aenp61NDQoKmpKYXDYR06dEhut1vRaDR2lF86SjztviXeUT8S
-DscG/fbbb+vosWM6cuSIvF6v9uzZo9QkP/XevHmztm/fro6ODu0sL5fDblcoFNJPFy/qb++9F3vd
-y+735OSk7t69q5plEcaz9AFJZkZG3O/b7Xbt2LlTly9d0vT0dNyInjXn1SRrfV/pj3mnp6cViUSe
-+LrNZtNer1eS1HvtWuz6dPkATCaTzGZz7E8iw5MUG/ryZy8ul0t///BD7WtsVFdXl/515IhmZmaS
-OliTyaSamhoZhqEbAwOxS6GqykrZbLYV1+Uvs98PHz58tJAJzmd2dvbpB6/09IT3L96cnyWZ6/vK
-BjI4NPTEfcaStMeLsbQo6x5fJ48uu7Z8EeHHR5blv4ThcFh2u13eujodOnRI42Njunr1asI/MxJ9
-sQ/68vLylJObq3OdnVpcXNTFixe1bdu2Fa952f1eugQZGxt75uucTuejA1Jvb+yXNd6zBEnKzMx8
-oTk/a17JXN+XXac/LJBUh0NdXV1xP58ef7ygFRUVkqQN69fLnZ+vzs7OuEe5Bw8famJiYsXfw3FO
-s4uLiyuOMAsLC7p0+XLs+263W6VlZU9su3SmW37aX7qJfjA/v+KsuPw18bZbvv1er1fjY2P6/vvv
-lZ+fH7uGXvK8+/1b69ev1+acHHV2dsZ9znT37l3Nzs4qIyND9fX1mpmZkc/ni3updu3aNf15374V
-l1eJznm1eSVrfRNdpzUZSHp6uvr6+vTtd99pZGREoVBIhmFoeHhYJ0+eVEVFhUpLS2M38fubmhQO
-h/XN8eMaGRlROBxWKBTSnTt3dDMYjB0FZ2ZmNPzrrzIMY8WlkmEYGhwcjIURjUZltVp15vRp3b59
-W5FIRGNjYxq8eVNFRUUrbiBHRkZig10KOjMzU66NG+Xz+zU/P6/Z2Vn19vauut1yHo9HTqdTPT09
-KikpifvhRaL7HfdDAotFb+7fL5vNphMnTmh0dFSRSESGYSgYDOr+/ftKf3yW9nq9qqysVFtbm65c
-uRL7JRwdHVXbiRPaXVOj2pqaFTf2ic55tXkla30TWac1+6BwYWFBP/f3y5mZqVu3bmngxg3NTE/L
-4/GoqLhYWwsKYvUvL7+3t1d9fX2ypaRoa0GBSkpKlJWVJUnq6+vT119/vWKbt956S263W59//nns
-5xmGIYfDoU8//VTt7e1KS0tTf3+/srKytGvXLuXm5kqSgsGg2tralJKSonA4LMMw5PF4dPDgwUeX
-LuPjOt/ZqZGREe0sL1d1VZVSUlJW3W45n9+vyYkJ1dfXP/N+7Vn7vZqJiQn19vaqv79fZrNZhYWF
-Ki0tfeJ5QCQS0dDQkAKBgG7cuCFJ2rp1q4qKimLPQF50ziaT6anzSub6JvK+a/ZJejIsfQKy/IYP
-/ztzXkvra30VFy7RjwTxas55La0v/+UWIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQ
-CEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCA
-QAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCA
-QAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEA
-BAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAQgEAIEABAIQCEAgAIEABAIQCEAgAIEA
-IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==")
- "The PNG data for a sensitive image placeholder.")
-
-(defun mastodon-media--process-image-response
- (status-plist url marker image-options region-length)
- "Callback function processing the url retrieve response for URL.
-STATUS-PLIST is the usual plist of status events as per `url-retrieve'.
-IMAGE-OPTIONS are the precomputed options to apply to the image.
-MARKER is the marker to where the response should be visible.
-REGION-LENGTH is the length of the region that should be replaced
-with the image."
- (when (marker-buffer marker) ; if buffer hasn't been killed
- (let ((url-buffer (current-buffer))
- (is-error-response-p (eq :error (car status-plist))))
- (let* ((data (unless is-error-response-p
- (goto-char (point-min))
- (and (search-forward "\n\n" nil t)
- (buffer-substring (point) (point-max)))))
- (image (when data
- (apply #'create-image data ;; inbuilt scaling in 27.1:
- (when (version< emacs-version "27.1")
- (when image-options 'imagemagick))
- t image-options))))
- (when mastodon-media--enable-image-caching
- (unless (url-is-cached url) ; cache if not already cached
- (url-store-in-cache url-buffer)))
- (with-current-buffer (marker-buffer marker)
- ;; Save narrowing in our buffer
- (let ((inhibit-read-only t))
- (save-restriction
- (widen)
- (put-text-property marker
- (+ marker region-length) 'media-state 'loaded)
- (when image
- ;; We only set the image to display if we could load
- ;; it; we already have set a default image when we
- ;; added the tag.
- (mastodon-media--display-image-or-sensitive
- marker region-length image))
- ;; We are done with the marker; release it:
- (set-marker marker nil)))
- (kill-buffer url-buffer))))))
-
-(defun mastodon-media--display-image-or-sensitive (marker region-length image)
- "Display image using display property, or add sensitive mask.
-MARKER, REGION-LENGTH and IMAGE are from
-`mastodon-media--process-image-response'.
-If the image is marked sensitive, the image is stored in
-image-data prop so it can be toggled."
- (if (or (not (eq t (get-text-property marker 'sensitive)))
- (not mastodon-media--hide-sensitive-media))
- ;; display image
- (put-text-property marker (+ marker region-length)
- 'display image)
- ;; display sensitive placeholder and save image data as prop:
- (add-text-properties marker (+ marker region-length)
- `(display
- ;; (image :type png :data ,mastodon-media--sensitive-image-data)
- ,(create-image
- mastodon-media--sensitive-image-data nil t)
- sensitive-state hidden image-data ,image))))
-
-(defvar mastodon-media--attachments nil
- "A list attachment details for full sized image view buffer.
-The first element is the URL of the image displayed, followed by plists
-of details of all of a toot's attachments.")
-
-(defun mastodon-media--process-full-sized-image-response
- (status-plist url attachments &optional prev-buf)
- ;; FIXME: refactor this with but not into
- ;; `mastodon-media--process-image-response'.
- "Callback function processing the `url-retrieve' response for URL.
-URL is a full-sized image URL attached to a timeline image.
-STATUS-PLIST is a plist of status events as per `url-retrieve'."
- (if-let* ((error-response (plist-get status-plist :error)))
- (user-error "error in loading image: %S" error-response)
- (when mastodon-media--enable-image-caching
- (unless (url-is-cached url) ;; cache if not already cached
- (url-store-in-cache)))
- ;; thanks to rahguzar for this idea:
- ;; https://codeberg.org/martianh/mastodon.el/issues/540
- (let* ((handle (mm-dissect-buffer t))
- (image (mm-get-image handle))
- (str (image-property image :data))
- (buf "*masto-image*"))
- (with-current-buffer (get-buffer-create buf)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert-image image str)
- (special-mode) ; prevent image-mode loop bug
- (mastodon-image-mode) ;; for our keymap
- (goto-char (point-min))
- (image-transform-fit-both)
- ;; set image metadata for view cycling:
- (setq-local mastodon-media--attachments (cons url attachments))))
- ;; switch to buf if not already viewing it:
- (unless (equal buf prev-buf)
- (switch-to-buffer-other-window buf))
- ;; display bindings if multiple images:
- (when (< 1 (length (cdr mastodon-media--attachments)))
- (message (substitute-command-keys
- "\\`.'/\\`>'/\\`<right>' to cycle images"))))))
-
-(defun mastodon-media--image-or-cached (url process-fun args)
- "Fetch URL from cache or fro host.
-Call PROCESS-FUN on it with ARGS, a list of callback args as
-specified by `url-retrieve'."
- (if (and mastodon-media--enable-image-caching
- (url-is-cached url)) ;; if cached, decompress and use:
- (with-current-buffer (url-fetch-from-cache url)
- (set-buffer-multibyte nil)
- (goto-char (point-min))
- (zlib-decompress-region
- (goto-char (search-forward "\n\n")) (point-max))
- (apply process-fun args)) ;; no status-plist arg from cache
- ;; fetch as usual and process-image-response will cache it:
- ;; cbargs fun will be called with status-plist by url-retrieve:
- (url-retrieve url process-fun (cdr args))))
-
-(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'.
-START is the position where we start loading the image.
-REGION-LENGTH is the range from start to propertize."
- (let ((image-options
- (when (mastodon-tl--image-trans-check)
- (cond ((eq media-type 'avatar)
- `(:height ,mastodon-media--avatar-height))
- ((eq media-type 'media-link)
- `(:max-height ,mastodon-media--preview-max-height)))))
- (buffer (current-buffer))
- (marker (copy-marker start))
- (url-show-status nil)) ; stop url.el from spamming us about connecting
- (condition-case nil
- ;; catch errors in url-retrieve to not break our caller
- (mastodon-media--image-or-cached
- url
- #'mastodon-media--process-image-response
- (list nil url marker image-options region-length))
- (error (with-current-buffer buffer
- ;; TODO: Add retries
- (put-text-property marker (+ marker region-length)
- 'media-state 'loading-failed)
- :loading-failed)))))
-
-(defun mastodon-media--select-next-media-line (end-pos)
- "Find coordinates of the next media to load before END-POS.
-Returns the list of (`start' . `end', `media-symbol') points of
-that line and string found or nil no more media links were
-found."
- (let ((next-pos (point)))
- (while
- (and
- (setq next-pos (next-single-property-change next-pos 'media-state))
- (or (not (eq 'needs-loading (get-text-property next-pos 'media-state)))
- (null (get-text-property next-pos 'media-url))
- (null (get-text-property next-pos 'media-type))))
- ;; do nothing - the loop will proceed
- )
- (when (and next-pos (< next-pos end-pos))
- (let ((media-type (get-text-property next-pos 'media-type)))
- (cond
- ((eq media-type 'avatar) ; avatars are one character
- (list next-pos (+ next-pos 1) 'avatar))
- ((eq media-type 'media-link) ; media links are 5 characters: [img]
- (list next-pos (+ next-pos 5) 'media-link)))))))
-
-(defun mastodon-media--valid-link-p (link)
- "Check if LINK is valid.
-Checks to make sure the missing string has not been returned."
- (and link
- (> (length link) 8)
- (or (string= "http://" (substring link 0 7))
- (string= "https://" (substring link 0 8)))))
-
-(defun mastodon-media--inline-images (search-start search-end)
- "Find all `Media_Links:' in the range from SEARCH-START to SEARCH-END.
-Replace them with the referenced image."
- (save-excursion
- (goto-char search-start)
- (let (line-details)
- (while (setq line-details
- (mastodon-media--select-next-media-line search-end))
- (let* ((start (car line-details))
- (end (cadr line-details))
- (media-type (cadr (cdr line-details)))
- (type (get-text-property start 'mastodon-media-type))
- (image-url (get-text-property start 'media-url)))
- (if (not (mastodon-media--valid-link-p image-url))
- ;; mark it at least as not needing loading any more
- (put-text-property start end 'media-state 'invalid-url)
- ;; proceed to load this image asynchronously
- (put-text-property start end 'media-state 'loading)
- (mastodon-media--load-image-from-url
- image-url media-type start (- end start))
- (when (or (string= type "gifv")
- (string= type "video"))
- (mastodon-media--moving-image-overlay start end))))))))
-
-;; (defvar-local mastodon-media--overlays nil
-;; "Holds a list of overlays in the buffer.")
-
-(defun mastodon-media--moving-image-overlay (start end)
- "Add play symbol overlay to moving image media items.
-START and END are the beginning and end of the media item to overlay."
- (let ((ov (make-overlay start end)))
- (overlay-put
- ov
- 'after-string
- (propertize ""
- 'help-echo "Video"
- 'face
- '((:height 3.5 :inherit mastodon-toot-docs-face))))))
-;; (cl-pushnew ov mastodon-media--overlays)))
-
-(defun mastodon-media--get-avatar-rendering (avatar-url)
- "Return the string to be written that renders the avatar at AVATAR-URL."
- ;; We use just an empty space as the textual representation.
- ;; This is what a user will see on a non-graphical display
- ;; where not showing an avatar at all is preferable.
- (let ((image-options (when (mastodon-tl--image-trans-check)
- `(:height ,mastodon-media--avatar-height))))
- (concat
- (propertize " "
- 'media-url avatar-url
- 'media-state 'needs-loading
- 'media-type 'avatar
- 'display
- (apply #'create-image mastodon-media--generic-avatar-data
- ;; inbuilt scaling in 27.1
- (when (version< emacs-version "27.1")
- (when image-options 'imagemagick))
- t image-options))
- " ")))
-
-(defun mastodon-media--get-media-link-rendering
- (media-url &optional full-remote-url type caption sensitive)
- "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.
-CAPTION is the image caption if provided.
-SENSITIVE is a flag from the item's JSON data."
- (let* ((help-echo-base
- (substitute-command-keys
- (concat "\\`RET': load full image or play video,\
- \\`i' for image options"
- (when (not (eq sensitive :json-false))
- ", \\`S': toggle sensitive media"))))
- (help-echo (if caption
- (concat help-echo-base
- "\n\"" caption "\"")
- help-echo-base)))
- (concat
- (mastodon-tl--propertize-img-str-or-url
- "[img]" media-url full-remote-url type help-echo
- (create-image mastodon-media--generic-broken-image-data nil t)
- nil caption sensitive)
- " ")))
-
-(provide 'mastodon-media)
-;;; mastodon-media.el ends here
+++ /dev/null
-;;; mastodon-notifications.el --- Notification functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebot@disroot.org>
-;; 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-notification.el provides notification functions for Mastodon.
-
-;;; Code:
-
-(require 'subr-x)
-(require 'cl-lib)
-(require 'mastodon-widget)
-(require 'map)
-
-(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-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--property "mastodon-tl")
-(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl")
-(autoload 'mastodon-tl--spoiler "mastodon-tl")
-(autoload 'mastodon-tl--item-id "mastodon-tl")
-(autoload 'mastodon-tl-update "mastodon-tl")
-(autoload 'mastodon-views-view-follow-requests "mastodon-views")
-(autoload 'mastodon-tl--current-filters "mastodon-views")
-(autoload 'mastodon-tl--render-text "mastodon-tl")
-(autoload 'mastodon-notifications-get "mastodon")
-(autoload 'mastodon-tl--byline-uname-+-handle "mastodon-tl")
-(autoload 'mastodon-tl--byline-handle "mastodon-tl")
-(autoload 'mastodon-http--get-json "mastodon-http")
-(autoload 'mastodon-media--get-avatar-rendering "mastodon-media")
-(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
-(autoload 'mastodon-tl--symbol "mastodon-tl")
-(autoload 'mastodon-tl--display-or-uname "mastodon-tl")
-(autoload 'mastodon-tl-goto-next-item "mastodon-tl")
-(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl")
-(autoload 'mastodon-tl--buffer-property "mastodon-tl")
-(autoload 'mastodon-http--patch "mastodon-http")
-(autoload 'mastodon-views--minor-view "mastodon-views")
-(autoload 'mastodon-tl--goto-first-item "mastodon-tl")
-(autoload 'mastodon-tl--init-sync "mastodon-tl")
-
-;; notifications defcustoms moved into mastodon.el
-;; as some need to be available without loading this file
-
-(defvar mastodon-tl--shr-map-replacement)
-(defvar mastodon-tl--horiz-bar)
-(defvar mastodon-active-user)
-(defvar mastodon-instance-url)
-(defvar mastodon-tl--buffer-spec)
-(defvar mastodon-tl--display-media-p)
-(defvar mastodon-mode-map)
-(defvar mastodon-tl--fold-toots-at-length)
-(defvar mastodon-tl--show-avatars)
-(defvar mastodon-profile-note-in-foll-reqs)
-(defvar mastodon-profile-note-in-foll-reqs-max-length)
-(defvar mastodon-group-notifications)
-(defvar mastodon-notifications-grouped-names-count)
-(defvar mastodon-tl--link-keymap)
-(defvar mastodon-tl--update-point)
-;;; VARIABLES
-
-(defvar mastodon-notifications--map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map mastodon-mode-map)
- (define-key map (kbd "a") #'mastodon-notifications-follow-request-accept)
- (define-key map (kbd "j") #'mastodon-notifications-follow-request-reject)
- (define-key map (kbd "C-k") #'mastodon-notifications-clear-current)
- (define-key map (kbd "C-c C-c") #'mastodon-notifications-cycle-type)
- map)
- "Keymap for viewing notifications.")
-
-(defvar mastodon-notifications--types
- '("all" "favourite" "reblog" "mention" "poll"
- "follow_request" "follow" "status" "update"
- "severed_relationships" "moderation_warning" "quote"
- "quoted_update")
- "A list of notification types according to their name on the server, plus \"all\".")
-
-(defvar mastodon-notifications--filter-types-alist
- '(("all" . mastodon-notifications-get)
- ("favourite" . mastodon-notifications-get-favourites)
- ("reblog" . mastodon-notifications-get-boosts)
- ("mention" . mastodon-notifications-get-mentions)
- ("poll" . mastodon-notifications-get-polls)
- ("follow_request" . mastodon-notifications-get-follow-requests)
- ("follow" . mastodon-notifications-get-follows)
- ("status" . mastodon-notifications-get-statuses)
- ("update" . mastodon-notifications-get-edits)
- ("quote" . mastodon-notifications-get-quotes)
- ("quoted_update" . mastodon-notifications-get-quoted-updates))
- "An alist of notification types and their corresponding load functions.
-Notification types are named according to their name on the server.")
-
-(defvar mastodon-notifications--response-alist
- '(("Followed" . "you")
- ("Favourited" . "your post")
- ("Boosted" . "your post")
- ("Mentioned" . "you")
- ("Posted a poll" . "that has now ended")
- ("Requested to follow" . "you")
- ("Posted" . "a post")
- ("Edited" . "their post")
- ("Quoted" . "your post")
- ;; FIXME: this is very annoying, but because "Edited" is used above,
- ;; we cannot reuse it here. I think this is because we use
- ;; `mastodon-notifications--action-alist' to go from (server) notif
- ;; type, to a string, and then use that string to get the rest of the
- ;; byline string from `mastodon-notifications--response-alist' here.
- ;; Ideally would just key the two strings according to notif type,
- ;; even if they did need to be gathered separately and combined.
- ("Modified" . "a post that you quoted"))
- "Alist of subjects for notification types.")
-
-(defvar mastodon-notifications--action-alist
- '((reblog . "Boosted")
- (favourite . "Favourited")
- (follow_request . "Requested to follow")
- (follow . "Followed")
- (mention . "Mentioned")
- (status . "Posted")
- (poll . "Posted a poll")
- (update . "Edited")
- (severed_relationships . "Relationships severed")
- (moderation_warning . "Moderation warning")
- (quote . "Quoted")
- (quoted_update . "Modified"))
- "Action strings keyed by notification type.
-Types are those of the Mastodon API.")
-
-(defvar mastodon-notifications--no-status-notif-alist
- '(("moderation_warning" . moderation_warning)
- ("severed_relationships" . event)
- ("follow" . follow)
- ("follow_request" . follow_request)))
-
-;;; VAR FETCHERS
-
-(defun mastodon-notifications--action-alist-get (type)
- "Return an action string for notification TYPE.
-Fetch from `mastodon-notifications--action-alist'.
-If no match, return empty string."
- (or (alist-get type mastodon-notifications--action-alist)
- ""))
-
-(defun mastodon-notifications--response-alist-get (message)
- "Return a response string for MESSAGE.
-Fetch from `mastodon-notifications--response-alist'.
-If no match, return empty string."
- (or (alist-get
- message
- mastodon-notifications--response-alist nil nil #'equal)
- ""))
-
-;;; UTILS
-
-(defun mastodon-notifications--api (endpoint)
- "Return a notifications API ENDPOINT.
-If `mastodon-group-notifications' is non-nil, use API v2."
- (mastodon-http--api endpoint
- (when mastodon-group-notifications "v2")))
-
-;;; FOLL REQS
-
-(defun mastodon-notifications--follow-request-process (&optional reject)
- "Process the follow request at point.
-With no argument, the request is accepted. Argument REJECT means
-reject the request. Can be called in notifications view or in
-follow-requests view."
- (if (not (mastodon-tl--find-property-range 'item-json (point)))
- (user-error "No follow request at point?")
- (let* ((item-json (mastodon-tl--property 'item-json))
- (f-reqs-view-p (string= "follow_requests"
- (plist-get mastodon-tl--buffer-spec 'endpoint)))
- (f-req-p (or (string= "follow_request"
- (mastodon-tl--property 'notification-type
- :no-move))
- f-reqs-view-p)))
- (if (not f-req-p)
- (user-error "No follow request at point?")
- (let-alist (or (alist-get 'account item-json) ;notifs
- item-json) ;f-reqs
- (if (not .id)
- (user-error "No account result at point?")
- (let ((response
- (mastodon-http--post
- (mastodon-http--api
- (format "follow_requests/%s/%s"
- .id (if reject "reject" "authorize"))))))
- (mastodon-http--triage
- response
- (lambda (_)
- (if f-reqs-view-p
- (mastodon-views-view-follow-requests)
- (mastodon-tl--reload-timeline-or-profile))
- (message "Follow request of %s (@%s) %s!"
- .username .acct (if reject "rejected" "accepted")))))))))))
-
-(defun mastodon-notifications-follow-request-accept ()
- "Accept a follow request.
-Can be called in notifications view or in follow-requests view."
- (interactive)
- (mastodon-notifications--follow-request-process))
-
-(defun mastodon-notifications-follow-request-reject ()
- "Reject a follow request.
-Can be called in notifications view or in follow-requests view."
- (interactive)
- (mastodon-notifications--follow-request-process :reject))
-
-;;; FORMAT NON-STANDARD NOTIFS
-
-(defun mastodon-notifications--severance-body (json)
- "Return a body for a severance notification JSON."
- ;; https://docs.joinmastodon.org/entities/RelationshipSeveranceEvent/
- (let-alist json
- (concat .type ": "
- .target_name
- "\nRelationships affected: "
- "\nFollowers: " (number-to-string .followers_count)
- "\nFollowing: " (number-to-string .following_count))))
-
-(defun mastodon-notifications--mod-warning-body (json)
- "Return a body for a moderation warning notification JSON."
- ;; https://docs.joinmastodon.org/entities/AccountWarning/
- (let-alist json
- (concat .action ": \"" (string-trim .text) "\""
- "\nStatuses: "
- (mastodon-notifications--render-mod-status-links .status_ids)
- "\nfor account: "
- .target_account.acct
- (if .appeal
- (concat "\nYour appeal: \""
- (alist-get 'text .appeal)
- "\"")
- "")
- "\nMore info/appeal: "
- (mastodon-notifications--render-mod-link .id))))
-
-(defun mastodon-notifications--propertize-link (url help-echo)
- "Render a plain URL link with HELP-ECHO."
- (propertize
- url
- 'face 'shr-link ;; mastodon-display-name-face
- 'keymap mastodon-tl--shr-map-replacement
- 'mastodon-tab-stop 'shr-url
- 'help-echo help-echo
- 'follow-link t
- 'mouse-face 'highlight
- 'shr-url url
- 'keymap mastodon-tl--shr-map-replacement))
-
-(defun mastodon-notifications--render-mod-status-links (ids)
- "Render moderation status IDS as URLs."
- (mapconcat (lambda (id)
- (let ((str (format "%s/@%s/%s"
- mastodon-instance-url
- mastodon-active-user id)))
- (mastodon-notifications--propertize-link str "view toot")))
- ids ", "))
-
-(defun mastodon-notifications--render-mod-link (id)
- "Render a moderation link for item with ID."
- (let ((str (format "%s/disputes/strikes/%s"
- mastodon-instance-url id)))
- (mastodon-notifications--propertize-link str "View mod warning")))
-
-;;; FORMAT/INSERT SINGLE NOTIF
-
-(defun mastodon-notifications--format-note (note)
- "Format for a NOTE, a non-grouped notification."
- (let* ((type (intern (alist-get 'type note)))
- (profile-note
- (when (eq 'follow_request type)
- (let ((str (mastodon-tl--field
- 'note
- (mastodon-tl--field 'account note))))
- (if mastodon-profile-note-in-foll-reqs-max-length
- (string-limit str mastodon-profile-note-in-foll-reqs-max-length)
- str))))
- (status (mastodon-tl--field 'status note))
- (follower (alist-get 'account note))
- (follower-name (mastodon-notifications--follower-name follower))
- (filtered (mastodon-tl--field 'filtered status))
- (filters (when filtered
- (mastodon-tl--current-filters filtered))))
- (if (and filtered (assoc "hide" filters))
- nil
- (mastodon-notifications--insert-note
- ;; toot
- ;; should always be note, otherwise notif data not avail
- ;; later on:
- note
- ;; body
- (mastodon-notifications--body-arg
- type filters status profile-note follower-name nil note)
- ;; action-byline (top)
- (mastodon-notifications--action-byline
- type nil nil note follower-name)
- ;; base toot (always provide)
- status
- nil nil nil type))))
-
-(defun mastodon-notifications--format-group-note (group status accounts)
- "Format for a GROUP notification.
-STATUS is the status's JSON.
-ACCOUNTS is data of the accounts that have reacted to the notification."
- (let ((folded nil))
- ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot'
- (let-alist group
- (let* ((type (intern .type))
- (profile-note
- (when (member type '(follow_request))
- (let ((str (mastodon-tl--field 'note (car accounts))))
- (if mastodon-profile-note-in-foll-reqs-max-length
- (string-limit str mastodon-profile-note-in-foll-reqs-max-length)
- str))))
- (follower (when (member type '(follow follow_request))
- (car accounts)))
- (follower-name (mastodon-notifications--follower-name follower))
- (filtered (mastodon-tl--field 'filtered status))
- (filters (when filtered
- (mastodon-tl--current-filters filtered))))
- (unless (and filtered (assoc "hide" filters))
- (mastodon-notifications--insert-note
- ;; toot
- (if (member type '(follow follow_request))
- follower
- status)
- ;; body
- (mastodon-notifications--body-arg
- type filters status profile-note follower-name group)
- ;; action-byline
- (mastodon-notifications--action-byline
- type accounts group)
- ;; base toot (no need for update/poll/?)
- (when (member type '(favourite reblog))
- status)
- folded group accounts))))))
-
-(defun mastodon-notifications--follower-name (follower)
- "Return display_name or username of FOLLOWER."
- (if (not (string= "" (alist-get 'display_name follower)))
- (alist-get 'display_name follower)
- (alist-get 'username follower)))
-
-(defun mastodon-notifications--comment-note-text (str)
- "Add comment face to all text in STR with `shr-text' face only."
- (with-temp-buffer
- (insert str)
- (goto-char (point-min))
- (let (prop)
- (while (setq prop (text-property-search-forward 'face 'shr-text t))
- (add-text-properties (prop-match-beginning prop)
- (prop-match-end prop)
- '(face (mastodon-toot-docs-face shr-text)))))
- (buffer-string)))
-
-(defun mastodon-notifications--body-arg
- (type &optional filters status profile-note follower-name group note)
- "Prepare a notification body argument.
-The string returned is passed to `mastodon-notifications--insert-note'.
-TYPE is a symbol, a member of `mastodon-notifiations--types'.
-FILTERS STATUS PROFILE-NOTE FOLLOWER-NAME GROUP NOTE."
- (let ((body
- (if-let* ((match (assoc "warn" filters)))
- (mastodon-tl--spoiler status (cadr match))
- (mastodon-tl--clean-tabs-and-nl
- (cond ((mastodon-tl--has-spoiler status)
- (mastodon-tl--spoiler status))
- ((eq type 'follow_request)
- (mastodon-tl--render-text profile-note))
- (t (mastodon-tl--content status)))))))
- (cond
- ((not (member (symbol-name type)
- mastodon-notifications--types))
- "Unknown notification type.")
- ((eq type 'follow)
- (propertize "Congratulations, you have a new follower!"
- 'face 'default
- 'item-type 'follow-request)) ;; nav
- ((eq type 'follow_request)
- (concat
- (propertize (format "You have a follow request from %s"
- follower-name)
- 'face 'default
- 'item-type 'follow-request) ;; nav
- (when mastodon-profile-note-in-foll-reqs
- (concat
- ":\n"
- (mastodon-notifications--comment-note-text body)))))
- ((eq type 'severed_relationships)
- (mastodon-notifications--severance-body
- (alist-get 'event (or group note))))
- ((eq type 'moderation_warning)
- (mastodon-notifications--mod-warning-body
- (alist-get 'moderation_warning (or group note))))
- ((member type '(favourite reblog))
- (propertize
- (mastodon-notifications--comment-note-text body)))
- (t body))))
-
-(defun mastodon-notifications--insert-note
- (toot body action-byline
- &optional base-toot unfolded group accounts type)
- "Display the content and byline of timeline element TOOT.
-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 a string, obtained by calling
-`mastodon-notifications--action-byline'.
-BASE-TOOT is the JSON of the toot responded to.
-UNFOLDED is a boolean meaning whether to unfold or fold item if
-foldable.
-GROUP is the notification group data.
-ACCOUNTS is the notification accounts data.
-TYPE is notification type, used for non-group notifs."
- (let* ((type (if type
- (symbol-name type) ;; non-group
- (alist-get 'type group)))
- (toot-foldable
- (and mastodon-tl--fold-toots-at-length
- (length> body mastodon-tl--fold-toots-at-length)))
- (ts ;; types listed here use base item timestamp, else we use
- ;; group's latest timestamp:
- (when (and group
- (not
- (member type '("favourite" "reblog" "edit" "poll"))))
- (mastodon-tl--field 'latest_page_notification_at group))))
- (insert
- (propertize ;; top byline, body + byline:
- (concat
- (if (equal type "mention") ;; top (action) byline
- ""
- action-byline)
- (propertize body ;; body only
- 'toot-body t) ;; includes newlines etc. for folding
- "\n"
- ;; display quoted post:
- (when (alist-get 'quote toot)
- (mastodon-tl--insert-quoted (alist-get 'quote toot)))
- ;; actual byline:
- (if (member type '("severed_relationships" "moderation_warning"))
- (propertize
- (concat mastodon-tl--horiz-bar "\n")
- 'byline t)
- (mastodon-tl--byline toot nil nil base-toot group ts)))
- 'item-type 'toot ;; for nav, actions, etc.
- 'item-id (or (alist-get 'page_max_id group) ;; newest notif
- (alist-get 'id toot)) ; toot id
- 'base-item-id (mastodon-tl--item-id
- ;; if status is a notif, get id from base-toot
- ;; (-tl--item-id toot) will not work here:
- (or base-toot
- toot)) ; else normal toot with reblog check
- 'item-json toot
- 'base-toot base-toot
- 'cursor-face 'mastodon-cursor-highlight-face
- 'toot-foldable toot-foldable
- 'toot-folded (and toot-foldable (not unfolded))
- ;; grouped notifs data:
- 'notification-type type
- 'notification-id (alist-get 'group_key group)
- 'notification-group group
- 'notification-accounts accounts
- ;; for pagination:
- 'notifications-min-id (alist-get 'page_min_id group)
- 'notifications-max-id (alist-get 'page_max_id group))
- "\n")))
-
-;;; BYLINES
-
-(defun mastodon-notifications--action-byline
- (type &optional accounts group note follower-name)
- "Return an action (top) byline for notification of TYPE.
-ACCOUNTS and GROUP group are used by grouped notifications.
-NOTE and FOLLOWER-NAME are used for non-grouped notifs."
- (let* ((str-prefix (mastodon-notifications--action-alist-get type))
- (action-str
- (unless (member type '(follow follow_request mention))
- (downcase
- (mastodon-notifications--byline-action-str
- str-prefix))))
- (action-symbol (if (eq type 'mention)
- ""
- (mastodon-tl--symbol type)))
- (action-authors
- (cond
- ((not (member (symbol-name type)
- mastodon-notifications--types))
- "")
- ((member type
- '(follow follow_request mention
- severed_relationships moderation_warning))
- "") ;; mentions are normal statuses
- (group
- (mastodon-notifications--byline-accounts accounts group))
- (t (mastodon-tl--byline-handle note nil
- follower-name
- 'mastodon-display-name-face)))))
- (propertize
- (concat action-symbol " " action-authors action-str)
- 'byline-top t)))
-
-(defun mastodon-notifications--byline-action-str (message)
- "Return an action (top) byline string for TOOT with MESSAGE."
- (let ((resp (mastodon-notifications--response-alist-get message)))
- (concat " "
- (propertize message 'face 'mastodon-boosted-face)
- " " resp "\n")))
-
-(defun mastodon-notifications--alist-by-value (str field json)
- "From JSON, return the alist whose FIELD value matches STR.
-JSON is a list of alists."
- (cl-some (lambda (y)
- (when (string= str (alist-get field y))
- y))
- json))
-
-(defun mastodon-notifications--group-accounts (ids json)
- "For IDS, return account data in JSON."
- (cl-loop
- for x in ids
- collect (mastodon-notifications--alist-by-value x 'id json)))
-
-(defun mastodon-notifications--byline-accounts
- (accounts group &optional avatar)
- "Propertize author byline ACCOUNTS.
-GROUP is the group notification data.
-When AVATAR, include the account's avatar image."
- (let ((total (alist-get 'notifications_count group))
- (accts mastodon-notifications-grouped-names-count))
- (concat
- (string-trim ;; remove trailing newline
- (cl-loop
- for account in accounts
- repeat accts
- concat
- (let-alist account
- (concat
- ;; avatar insertion moved up to `mastodon-tl--byline' by
- ;; default to be outside 'byline propt.
- (when (and avatar ; used by `mastodon-profile--format-user'
- mastodon-tl--show-avatars
- mastodon-tl--display-media-p
- (mastodon-tl--image-trans-check))
- (mastodon-media--get-avatar-rendering .avatar))
- (let ((uname (mastodon-tl--display-or-uname account)))
- (mastodon-tl--byline-handle account nil
- uname 'mastodon-display-name-face))
- ", ")))
- nil ", ")
- (if (< accts total)
- (let ((diff (- total accts)))
- (propertize ;; help-echo remaining notifs authors:
- (format " and %s other%s" diff (if (= 1 diff) "" "s"))
- 'help-echo (mapconcat (lambda (a)
- (propertize (alist-get 'username a)
- 'face 'mastodon-display-name-face))
- (cddr accounts) ;; not first two
- ", ")))))))
-
-;;; LOAD TIMELINE
-
-(defun mastodon-notifications--render (json no-group)
- "Display grouped notifications in JSON.
-NO-GROUP means don't render grouped notifications."
- ;; (setq masto-grouped-notifs json)
- (let ((start-pos (point)))
- (if no-group
- (cl-loop for x in json
- do (mastodon-notifications--format-note x))
- (cl-loop
- for g in (alist-get 'notification_groups json)
- for accounts = (mastodon-notifications--group-accounts
- (alist-get 'sample_account_ids g)
- (alist-get 'accounts json))
- for type = (alist-get 'type g)
- for status = (mastodon-notifications--status-or-event g type json)
- do (mastodon-notifications--format-group-note g status accounts)))
- (when mastodon-tl--display-media-p
- ;; images-in-notifs custom is handeld in
- ;; `mastodon-tl--media-attachment', not here
- (mastodon-media--inline-images start-pos (point)))))
-
-(defun mastodon-notifications--status-or-event (group type json)
- "Return a notification's status or event data.
-Using GROUP data, notification TYPE, and overall notifs JSON."
- (if (member type (map-keys mastodon-notifications--no-status-notif-alist))
- ;; notifs w no status data:
- (let ((key (alist-get type mastodon-notifications--no-status-notif-alist
- nil nil #'equal)))
- (alist-get key group))
- (mastodon-notifications--alist-by-value
- (alist-get 'status_id group)
- 'id
- (alist-get 'statuses json))))
-
-(defun mastodon-notifications--empty-group-json-p (json)
- "Non-nil if JSON is empty grouped notifs data."
- (equal json '((accounts) (statuses) (notification_groups))))
-
-(defun mastodon-notifications--timeline (json &optional type update)
- "Format JSON in Emacs buffer.
-Optionally specify TYPE.
-UPDATE means we are updating, so skip some things."
- (if (seq-empty-p json)
- (user-error "Looks like you have no (more) notifications for now")
- (unless update
- (mastodon-widget--create
- "Filter" mastodon-notifications--types
- (or type "all")
- (lambda (widget &rest _ignore)
- (let ((value (widget-value widget)))
- (mastodon-notifications-get-type value)))
- :newline)
- (insert "\n"))
- ;; filtered/requests message:
- (when (mastodon-notifications--notif-requests)
- (insert
- (substitute-command-keys
- "You have filtered notifications. \
-\\[mastodon-notifications-requests] to view requests.\n\n")))
- ;; set update point:
- (setq mastodon-tl--update-point (point))
- ;; render:
- (mastodon-notifications--render json
- (not mastodon-group-notifications))
- (goto-char (point-min))
- ;; set last read notif ID:
- (save-excursion
- (mastodon-tl-goto-next-item :no-refresh)
- (let ((id (mastodon-tl--property 'item-id))) ;; notif not base
- (mastodon-notifications--set-last-read id)))
- (unless update ;; already in tl--update
- (mastodon-tl-goto-next-item))))
-
-;;; VIEW LOADING FUNCTIONS
-
-(defun mastodon-notifications-get-type (&optional type)
- "Read a notification type and load its timeline.
-Optionally specify TYPE."
- (interactive)
- (let ((choice (or type
- (completing-read
- "View notifications: "
- mastodon-notifications--filter-types-alist))))
- (funcall (alist-get
- choice mastodon-notifications--filter-types-alist
- nil nil #'equal))))
-
-(defun mastodon-notifications-cycle-type (&optional prefix)
- "Cycle the current notifications view.
-With arg PREFIX, `completing-read' a type and load it."
- (interactive "P")
- ;; FIXME: do we need a sept buffer-type result for all notifs views?
- (if (not (or (mastodon-tl--buffer-type-eq 'notifications)
- (mastodon-tl--buffer-type-eq 'mentions)))
- (user-error "Not in a notifications view")
- (let* ((choice
- (if prefix
- (completing-read "Notifs by type: "
- mastodon-notifications--types)
- (mastodon-notifications--get-next-type)))
- (fun (alist-get choice mastodon-notifications--filter-types-alist
- nil nil #'equal)))
- (funcall fun))))
-
-(defun mastodon-notifications--current-type ()
- "Return the current notification type or nil."
- (let* ((update-params (mastodon-tl--buffer-property
- 'update-params nil :no-error)))
- (alist-get "types[]" update-params nil nil #'equal)))
-
-(defun mastodon-notifications--get-next-type ()
- "Return the next notif type based on current buffer spec."
- (let* ((type (mastodon-notifications--current-type)))
- (if (not type)
- (cadr mastodon-notifications--types)
- (or (cadr (member type mastodon-notifications--types))
- (car mastodon-notifications--types)))))
-
-(defun mastodon-notifications-get-mentions ()
- "Display mention notifications in buffer."
- (interactive)
- (mastodon-notifications-get "mention" "mentions"))
-
-(defun mastodon-notifications-get-favourites ()
- "Display favourite notifications in buffer."
- (interactive)
- (mastodon-notifications-get "favourite" "favourites"))
-
-(defun mastodon-notifications-get-boosts ()
- "Display boost notifications in buffer."
- (interactive)
- (mastodon-notifications-get "reblog" "boosts"))
-
-(defun mastodon-notifications-get-polls ()
- "Display poll notifications in buffer."
- (interactive)
- (mastodon-notifications-get "poll" "polls"))
-
-(defun mastodon-notifications-get-statuses ()
- "Display status notifications in buffer.
-Status notifications are created when you call
-`mastodon-tl-enable-notify-user-posts'."
- (interactive)
- (mastodon-notifications-get "status" "statuses"))
-
-(defun mastodon-notifications-get-follows ()
- "Display follow notifications in buffer."
- (interactive)
- (mastodon-notifications-get "follow" "follows"))
-
-(defun mastodon-notifications-get-follow-requests ()
- "Display follow request notifications in buffer."
- (interactive)
- (mastodon-notifications-get "follow_request" "follow-requests"))
-
-(defun mastodon-notifications-get-edits ()
- "Display edited post notifications in buffer."
- (interactive)
- (mastodon-notifications-get "update" "edits"))
-
-(defun mastodon-notifications--filter-types-list (type)
- "Return a list of notification types with TYPE removed."
- (remove type mastodon-notifications--types))
-
-;;; CLEAR/DISMISS NOTIFS
-
-(defun mastodon-notifications-clear-all ()
- "Clear all notifications."
- (interactive)
- (when (y-or-n-p "Clear all notifications?")
- (let ((response
- (mastodon-http--post
- (mastodon-notifications--api "notifications/clear"))))
- (mastodon-http--triage
- response (lambda (_)
- (when mastodon-tl--buffer-spec
- (mastodon-tl--reload-timeline-or-profile))
- (message "All notifications cleared!"))))))
-
-(defun mastodon-notifications-clear-current ()
- "Dismiss the notification at point."
- (interactive)
- (let* ((id (or ;; grouping enabled
- ;; (*should* also work for ungrouped items):
- (mastodon-tl--property 'notification-id)
- ;; FIXME: are these all required?
- (mastodon-tl--property 'item-id)
- (mastodon-tl--field
- 'id
- (mastodon-tl--property 'item-json))))
- (endpoint (mastodon-notifications--api
- (format "notifications/%s/dismiss" id)))
- (response (mastodon-http--post endpoint)))
- (mastodon-http--triage
- response (lambda (_)
- (when mastodon-tl--buffer-spec
- (mastodon-tl--reload-timeline-or-profile))
- (message "Notification dismissed!")))))
-
-;;; MISC
-
-(defun mastodon-notifications--set-last-read (id)
- "Set the last read notification ID on the server."
- (let ((endpoint (mastodon-http--api "markers"))
- (params `(("notifications[last_read_id]" . ,id))))
- (mastodon-http--post endpoint params)))
-
-(defun mastodon-notifications--get-last-read ()
- "Return the last read notification ID from the server."
- (let* ((params '(("timeline[]" . "notifications")))
- (endpoint (mastodon-http--api "markers"))
- (resp (mastodon-http--get-json endpoint params)))
- (map-nested-elt resp '(notifications last_read_id))))
-
-(defun mastodon-notifications-get-single-notif ()
- "Return a single notification JSON for v2 notifs."
- (interactive)
- (let* ((id ;; grouped (should work for ungrouped items):
- (mastodon-tl--property 'notification-id))
- (endpoint (mastodon-notifications--api
- (format "notifications/%s" id)))
- (response (mastodon-http--get-json endpoint)))
- (message "%s" (prin1-to-string response))))
-
-(defun mastodon-notifications--get-unread-count ()
- "Return the number of unread notifications for the current account."
- ;; params: limit - max 1000, default 100, types[], exclude_types[], account_id
- (let* ((endpoint "notifications/unread_count")
- (url (mastodon-http--api endpoint
- (when mastodon-group-notifications "v2")))
- (resp (mastodon-http--get-json url)))
- (alist-get 'count resp)))
-
-;;; NOTIFICATION REQUESTS / FILTERING / POLICY
-
-(defvar mastodon-notifications--requests-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map mastodon-mode-map)
- (define-key map (kbd "j") #'mastodon-notifications-request-reject)
- (define-key map (kbd "a") #'mastodon-notifications-request-accept)
- (define-key map (kbd "g") #'mastodon-notifications-requests)
- map)
- "Keymap for viewing follow requests.")
-
-;; FIXME: these are only for grouped notifs, else the fields are JSON bools
-(defvar mastodon-notifications-policy-vals
- '("accept" "filter" "drop"))
-
-(defun mastodon-notifications-get-policy ()
- "Return the notification filtering policy."
- (let ((url (mastodon-notifications--api "notifications/policy")))
- (mastodon-http--get-json url)))
-
-(defun mastodon-notifications--notif-requests ()
- "Non-nil if the user currently has pending/filtered notifications.
-Returns"
- (let* ((policy (mastodon-notifications-get-policy))
- (count (map-nested-elt policy '(summary pending_notifications_count))))
- (if (and count (> count 0))
- count)))
-
-(defun mastodon-notifications--pending-p ()
- "Non-nil if there are any pending requests or notifications."
- (let* ((json (mastodon-notifications-get-policy))
- (summary (alist-get 'summary json)))
- (or (not (= 0 (alist-get 'pending_requests_count summary)))
- (not (= 0 (alist-get 'pending_notifications_count summary))))))
-
-(defun mastodon-notifications--update-policy (&optional params)
- "Update notifications filtering policy.
-PARAMS is an alist of parameters."
- ;; https://docs.joinmastodon.org/methods/notifications/#update-the-filtering-policy-for-notifications
- (let ((url (mastodon-notifications--api "notifications/policy")))
- (mastodon-http--patch url params)))
-
-(defun mastodon-notifications--get-requests (&optional params)
- "Get a list of notification requests data from the server.
-PARAMS is an alist of parameters."
- ;; NB: link header pagination
- (let ((url (mastodon-notifications--api "notifications/requests")))
- (mastodon-http--get-json url params)))
-
-(defun mastodon-notifications-request-accept (&optional reject)
- "Accept a notification request for a user.
-This will merge any filtered notifications from them into the main
-notifications and accept any future notification from them.
-REJECT means reject notifications instead."
- ;; POST /api/v1/notifications/requests/:id/accept
- (interactive)
- (let* ((id (mastodon-tl--property 'item-id))
- (user (mastodon-tl--property 'notif-req-user))
- (url (mastodon-http--api
- (format "notifications/requests/%s/%s"
- id (if reject "dismiss" "accept"))))
- (resp (mastodon-http--post url)))
- (mastodon-http--triage
- resp
- (lambda (_resp)
- (message "%s notifications from %s"
- (if reject "Not accepting" "Accepting") user)
- ;; reload view:
- (mastodon-notifications-requests)))))
-
-(defun mastodon-notifications-request-reject ()
- "Reject a notification request for a user.
-Rejecting a request means any notifications from them will continue to
-be filtered."
- (interactive)
- (mastodon-notifications-request-accept :reject))
-
-(defun mastodon-notifications-requests ()
- "Open a new buffer displaying the user's notification requests."
- ;; calqued off `mastodon-views-view-follow-requests'
- (interactive)
- (mastodon-tl--init-sync
- "notification-requests"
- "notifications/requests"
- 'mastodon-views--insert-notification-requests
- nil
- '(("limit" . "40")) ; server max is 80
- :headers
- "notification requests"
- "a/j - accept/reject request at point\n\
- n/p - go to next/prev request\n\
- \\[mastodon-notifications-policy] - set filtering policy")
- (mastodon-tl--goto-first-item)
- (with-current-buffer "*mastodon-notification-requests*"
- (use-local-map mastodon-notifications--requests-map)))
-
-(defun mastodon-views--insert-notification-requests (json)
- "Insert the user's current notification requests.
-JSON is the data returned by the server."
- (mastodon-views--minor-view
- "notification requests"
- #'mastodon-notifications--insert-users
- json))
-;; masto-notif-req))
-
-(defun mastodon-notifications--insert-users (json)
- "Insert users list into the buffer.
-JSON is the data from the server."
- ;; calqued off `mastodon-views--insert-users-propertized-note'
- ;; and `mastodon-search--insert-users-propertized'
- (cl-loop for req in json
- do (insert
- (concat
- (mastodon-notifications--format-req-user req)
- mastodon-tl--horiz-bar "\n\n"))))
-
-(defun mastodon-notifications--format-req-user (req &optional note)
- "Format a notification request user, REQ.
-NOTE means to include a profile note."
- ;; calqued off `mastodon-search--propertize-user'
- (let-alist req
- (propertize
- (concat
- (propertize .account.username
- 'face 'mastodon-display-name-face
- 'byline t
- 'notif-req-user .account.username
- 'item-type 'notif-req
- 'item-id .id) ;; notif req id
- " : \n : "
- (propertize (concat "@" .account.acct)
- 'face 'mastodon-handle-face
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'user-handle
- 'keymap mastodon-tl--link-keymap
- 'mastodon-handle (concat "@" .account.acct)
- 'help-echo (concat "Browse user profile of @" .account.acct))
- " : \n"
- (when note
- (mastodon-tl--render-text .account.note .account))
- "\n")
- 'item-json req)))
-
-(provide 'mastodon-notifications)
-;;; mastodon-notifications.el ends here
+++ /dev/null
-;; -*- no-byte-compile: t; lexical-binding: nil -*-
-(define-package "mastodon" "20251201.1553"
- "Client for fediverse services using the Mastodon API."
- '((emacs "28.1")
- (persist "0.8")
- (tp "0.7"))
- :url "https://codeberg.org/martianh/mastodon.el"
- :commit "3c00418bfbb13f450551c28a97f8870e8ce3fef9"
- :revdesc "3c00418bfbb1"
- :authors '(("Johnson Denen" . "johnson.denenNOSPAMgmail.com")
- ("Marty Hiatt" . "mousebotNOSPAMdisroot.org"))
- :maintainers '(("Marty Hiatt" . "mousebotNOSPAMdisroot.org")))
+++ /dev/null
-;;; mastodon-profile.el --- Functions for inspecting Mastodon profiles -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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-profile.el generates a stream of users toots.
-;; To add
-;; - Option to follow
-;; - wheather they follow you or not
-;; - Show only Media
-
-;;; Code:
-(require 'seq)
-(require 'cl-lib)
-(require 'persist)
-(require 'parse-time)
-(require 'mastodon-http)
-(eval-when-compile
- (require 'mastodon-tl))
-(require 'mastodon-widget)
-
-(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-kill-window "mastodon")
-(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--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--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--toot "mastodon-tl")
-(autoload 'mastodon-tl--item-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")
-(autoload 'mastodon-return-credential-account "mastodon")
-(autoload 'mastodon-tl--buffer-property "mastodon-tl")
-(autoload 'mastodon-search-query "mastodon-search")
-(autoload 'mastodon-tl--field-status "mastodon-tl")
-(autoload 'mastodon-toot--with-toot-item "mastodon-toot" nil nil 'macro)
-(autoload 'mastodon-tl--toot-or-base "mastodon-tl")
-
-(defvar mastodon-active-user)
-(defvar mastodon-tl--horiz-bar)
-(defvar mastodon-tl--update-point)
-(defvar mastodon-toot--max-toot-chars)
-(defvar mastodon-toot--visibility)
-(defvar mastodon-toot--content-nsfw)
-(defvar mastodon-tl--timeline-posts-count)
-
-(defvar-local mastodon-profile--account nil
- "The data for the account being described in the current profile buffer.")
-
-(defvar mastodon-profile-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle)
- (define-key map (kbd "C-c C-s") #'mastodon-profile-account-search)
- (define-key map (kbd "C-c #") #'mastodon-profile-open-statuses-tagged)
- map)
- "Keymap for `mastodon-profile-mode'.")
-
-(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
-extra keybindings."
- :init-value nil
- :lighter " Profile"
- :keymap mastodon-profile-mode-map
- :group 'mastodon
- :global nil)
-
-(defvar mastodon-profile-credential-account nil
- "Holds the JSON data of the CredentialAccount entity.
-It contains details of the current user's account.")
-
-(defvar mastodon-profile-acccount-preferences-data nil
- "Holds the JSON data of the current user's preferences.")
-
-(defvar mastodon-profile-update-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") #'mastodon-profile-user-profile-send-updated)
- (define-key map (kbd "C-c C-k") #'mastodon-profile-update-profile-note-cancel)
- map)
- "Keymap for `mastodon-profile-update-mode'.")
-
-(persist-defvar mastodon-profile-account-settings nil
- "An alist of account settings saved from the server.
-Other clients can change these settings on the server at any
-time, so this list is not the canonical source for settings. It
-is updated on entering mastodon mode and on toggle any setting it
-contains.
-This variable is set from data in
-`mastodon-profile-credential-account' not
-`mastodon-profile-account-preferences-data'.")
-
-(define-minor-mode mastodon-profile-update-mode
- "Minor mode to update user profile."
- :group 'mastodon-profile
- :keymap mastodon-profile-update-mode-map
- :global nil)
-
-(defun mastodon-profile--item-json ()
- "Get the next item-json."
- (mastodon-tl--property 'item-json))
-
-(defun mastodon-profile--make-author-buffer
- (account &optional no-reblogs no-replies only-media tag max-id)
- "Take an ACCOUNT json and insert a user account into a new buffer.
-NO-REBLOGS means do not display boosts in statuses.
-NO-REPLIES means to exlude replies.
-ONLY-MEDIA means show only posts containing attachments.
-TAG is a hashtag to restrict posts to.
-MAX-ID is a flag to include the max_id pagination parameter."
- (mastodon-profile--make-profile-buffer-for
- account "statuses" #'mastodon-tl--timeline no-reblogs nil
- no-replies only-media tag max-id))
-
-;;; PROFILE VIEW COMMANDS
-
-(defvar mastodon-profile--account-view-alist
- '((statuses . mastodon-profile-open-statuses)
- (no-boosts . mastodon-profile-open-statuses-no-reblogs)
- (no-replies . mastodon-profile-open-statuses-no-replies)
- (only-media . mastodon-profile-open-statuses-only-media)
- (followers . mastodon-profile-open-followers)
- (following . mastodon-profile-open-following)
- (tag . mastodon-profile-open-statuses-tagged)))
-
-(defun mastodon-profile--view-types ()
- "Return the keys of `mastodon-profile--account-view-alist' as a list."
- (map-keys mastodon-profile--account-view-alist))
-
-(defun mastodon-profile-account-view-cycle (&optional prefix)
- "Cycle through profile view: toots, toot sans boosts, followers, and following.
-If a PREFIX argument is provided, prompt for a view type and load."
- (interactive "P")
- (if prefix
- (let* ((choice
- (completing-read "Profile view:"
- mastodon-profile--account-view-alist))
- (fun (alist-get choice mastodon-profile--account-view-alist)))
- (funcall fun))
- (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-statuses-no-replies))
- ((mastodon-tl--buffer-type-eq 'profile-statuses-no-replies)
- (mastodon-profile-open-statuses-only-media))
- ((mastodon-tl--buffer-type-eq 'profile-statuses-only-media)
- (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)))))
-
-(defun mastodon-profile-open-statuses ()
- "Open a profile showing statuses."
- (interactive)
- (if mastodon-profile--account
- (mastodon-profile--make-author-buffer
- mastodon-profile--account)
- (user-error "Not in a mastodon profile")))
-
-(defun mastodon-profile-open-statuses-no-replies ()
- "Open a profile buffer showing statuses without replies."
- (interactive)
- (if mastodon-profile--account
- (mastodon-profile--make-author-buffer
- mastodon-profile--account nil :no-replies)
- (user-error "Not in a mastodon profile")))
-
-(defun mastodon-profile-open-statuses-no-reblogs ()
- "Open a profile buffer showing statuses without reblogs."
- (interactive)
- (if mastodon-profile--account
- (mastodon-profile--make-author-buffer
- mastodon-profile--account :no-reblogs)
- (user-error "Not in a mastodon profile")))
-
-(defun mastodon-profile-open-statuses-only-media ()
- "Open a profile buffer showing only statuses with media."
- (interactive)
- (if mastodon-profile--account
- (mastodon-profile--make-author-buffer
- mastodon-profile--account nil nil :only-media)
- (user-error "Not in a mastodon profile")))
-
-(defun mastodon-profile-open-statuses-tagged ()
- "Prompt for a hashtag and display a profile with only statuses containing it."
- (interactive)
- (let ((tag (read-string "Statuses containing tag: ")))
- (if mastodon-profile--account
- (mastodon-profile--make-author-buffer
- mastodon-profile--account nil nil nil tag)
- (user-error "Not in a mastodon profile"))))
-
-(defun mastodon-profile-open-following ()
- "Open a profile buffer showing the accounts that current profile follows."
- (interactive)
- (if mastodon-profile--account
- (mastodon-profile--make-profile-buffer-for
- mastodon-profile--account "following"
- #'mastodon-profile--format-user nil :headers)
- (user-error "Not in a mastodon profile")))
-
-(defun mastodon-profile-open-followers ()
- "Open a profile buffer showing the accounts following the current profile."
- (interactive)
- (if mastodon-profile--account
- (mastodon-profile--make-profile-buffer-for
- mastodon-profile--account "followers"
- #'mastodon-profile--format-user nil :headers)
- (user-error "Not in a mastodon profile")))
-
-(defun mastodon-profile-view-favourites ()
- "Open a new buffer displaying the user's favourites."
- (interactive)
- (message "Loading your favourited toots...")
- (mastodon-tl--init "favourites" "favourites"
- 'mastodon-tl--timeline :headers))
-
-(defun mastodon-profile-view-bookmarks ()
- "Open a new buffer displaying the user's bookmarks."
- (interactive)
- (message "Loading your bookmarked toots...")
- (mastodon-tl--init "bookmarks" "bookmarks"
- 'mastodon-tl--timeline :headers))
-
-(defun mastodon-profile-add-account-to-list ()
- "Add account of current profile buffer to a list."
- (interactive)
- (if (not mastodon-profile--account)
- (user-error "No profile to add?")
- (let-alist mastodon-profile--account
- (mastodon-views-add-account-to-list nil .id .acct))))
-
-(defun mastodon-profile-account-search (query)
- "Run a statuses search QUERY for the currently viewed account."
- (interactive "sSearch account for: ")
- (let* ((ep (mastodon-tl--buffer-property 'endpoint))
- (id (nth 1 (split-string ep "/"))))
- (mastodon-search-query query "statuses" nil nil id)))
-
-\f
-;;; ACCOUNT PREFERENCES
-
-(defun mastodon-profile--get-account-value (key function)
- "Fetch KEY from data returned by FUNCTION.
-If value is :json-false, return nil."
- (let* ((response (funcall function))
- (value (alist-get key response)))
- (if (eq value :json-false) nil value)))
-
-(defun mastodon-profile--get-json-value (key)
- "Fetch value for KEY from account.
-Account details are from `mastodon-return-credential-account'.
-If value is :json-false, return nil."
- (mastodon-profile--get-account-value
- key #'mastodon-return-credential-account))
-
-(defun mastodon-profile--get-source-values ()
- "Return the \"source\" preferences from the server."
- (mastodon-profile--get-json-value 'source))
-
-(defun mastodon-profile--get-source-value (pref)
- "Return PREF erence from the account's \"source\" field."
- (mastodon-profile--get-account-value
- pref #'mastodon-profile--get-source-values))
-
-(defun mastodon-profile-update-user-profile-note ()
- "Fetch user's profile note and display for editing."
- (interactive)
- (let* ((source (mastodon-profile--get-source-values))
- (note (alist-get 'note source))
- (buffer (get-buffer-create "*mastodon-update-profile*"))
- (inhibit-read-only t)
- (msg-str
- (substitute-command-keys
- "Edit your profile note. \\`C-c C-c' to send, \\`C-c C-k' to cancel.")))
- (switch-to-buffer-other-window buffer)
- (text-mode)
- (mastodon-tl--set-buffer-spec (buffer-name buffer)
- "accounts/verify_credentials" nil)
- (setq-local header-line-format msg-str)
- (mastodon-profile-update-mode t)
- (insert (propertize (concat
- (propertize "0"
- 'note-counter t
- 'display nil)
- "/500 characters")
- 'read-only t
- 'face 'mastodon-toot-docs-face
- 'note-header t)
- "\n")
- (make-local-variable 'after-change-functions)
- (cl-pushnew #'mastodon-profile--update-note-count after-change-functions)
- (let ((start-point (point)))
- (insert note)
- (goto-char start-point))
- (delete-trailing-whitespace) ; remove all ^M's
- (message msg-str)))
-
-(defun mastodon-profile--update-note-count (&rest _args)
- "Display the character count of the profile note buffer."
- (let* ((inhibit-read-only t)
- (header-region (mastodon-tl--find-property-range 'note-header
- (point-min)))
- (count-region (mastodon-tl--find-property-range 'note-counter
- (point-min)))
- (count (number-to-string (mastodon-toot--count-toot-chars
- (buffer-substring-no-properties
- (cdr header-region) (point-max))))))
- (add-text-properties (car count-region) (cdr count-region)
- (list 'display count))))
-
-(defun mastodon-profile-update-profile-note-cancel ()
- "Cancel updating user profile and kill buffer and window."
- (interactive)
- (when (y-or-n-p "Cancel updating your profile note?")
- (mastodon-kill-window)))
-
-(defun mastodon-profile--note-remove-header ()
- "Get the profile note, without the buffer header."
- (let ((header-region (mastodon-tl--find-property-range 'note-header
- (point-min))))
- (buffer-substring (cdr header-region) (point-max))))
-
-(defun mastodon-profile-user-profile-send-updated ()
- "Send PATCH request with the updated profile note.
-Ask for confirmation if length > 500 characters."
- (interactive)
- (let* ((note (mastodon-profile--note-remove-header))
- (url (mastodon-http--api "accounts/update_credentials")))
- (when (or (not (> (mastodon-toot--count-toot-chars note) 500))
- (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?"))
- (quit-window 'kill)
- (mastodon-profile--user-profile-send-updated-do url note))))
-
-(defun mastodon-profile--user-profile-send-updated-do (url note)
- "Send PATCH request with the updated profile NOTE to URL."
- (let ((response (mastodon-http--patch url `(("note" . ,note)))))
- (mastodon-http--triage response
- (lambda (_) (message "Profile note updated!")))))
-
-(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."
- (let* ((url (mastodon-http--api "accounts/update_credentials"))
- (pref-formatted (if source (concat "source[" pref "]") pref))
- (response (mastodon-http--patch url `((,pref-formatted . ,val)))))
- (mastodon-http--triage response
- (lambda (_)
- (mastodon-profile--fetch-server-account-settings)
- (message "Account setting %s updated to %s!" pref val)))))
-
-(defun mastodon-profile--get-pref (pref)
- "Return PREF from `mastodon-profile-account-settings'."
- (plist-get mastodon-profile-account-settings pref))
-
-(defun mastodon-profile--update-preference-plist (pref val)
- "Set local account preference plist preference PREF to VAL.
-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."
- (mastodon-profile--fetch-server-account-settings :no-force))
-
-;; FIXME: this does one request per setting! should just do one request then
-;; parse
-(defun mastodon-profile--fetch-server-account-settings (&optional no-force)
- "Fetch basic account settings from the server.
-Store the values in `mastodon-profile-account-settings'.
-Run in `mastodon-mode-hook'.
-If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil."
- (unless (and no-force mastodon-profile-account-settings)
- (let ((keys '(locked discoverable display_name bot))
- (source-keys '(privacy sensitive language)))
- (mapc (lambda (k)
- (mastodon-profile--update-preference-plist
- k (mastodon-profile--get-json-value k)))
- keys)
- (mapc (lambda (sk)
- (mastodon-profile--update-preference-plist
- sk (mastodon-profile--get-source-value sk)))
- source-keys)
- ;; hack for max toot chars:
- (mastodon-toot--get-max-toot-chars :no-toot)
- (mastodon-profile--update-preference-plist 'max_toot_chars
- mastodon-toot--max-toot-chars)
- ;; TODO: remove now redundant vars, replace with fetchers from the plist
- (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy)
- mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive))
- mastodon-profile-account-settings)))
-
-(defun mastodon-profile-account-locked-toggle ()
- "Toggle the locked status of your account.
-Locked means follow requests have to be approved."
- (interactive)
- (mastodon-profile--toggle-account-key 'locked))
-
-(defun mastodon-profile-account-discoverable-toggle ()
- "Toggle the discoverable status of your account.
-Discoverable means the account is listed in the server directory."
- (interactive)
- (mastodon-profile--toggle-account-key 'discoverable))
-
-(defun mastodon-profile-account-bot-toggle ()
- "Toggle the bot status of your account."
- (interactive)
- (mastodon-profile--toggle-account-key 'bot))
-
-(defun mastodon-profile-account-sensitive-toggle ()
- "Toggle the sensitive status of your account.
-When enabled, statuses are marked as sensitive by default."
- (interactive)
- (mastodon-profile--toggle-account-key 'sensitive :source))
-
-(defun mastodon-profile--toggle-account-key (key &optional source)
- "Toggle the boolean account setting KEY.
-SOURCE means the setting is located under \"source\" in the account JSON.
-Current settings are fetched from the server."
- (let* ((val (if source
- (mastodon-profile--get-source-value key)
- (mastodon-profile--get-json-value key)))
- (prompt (format "Account setting %s is %s. Toggle?" key val)))
- (when (y-or-n-p prompt)
- (mastodon-profile--update-preference (symbol-name key)
- (if val "false" "true")
- source))))
-
-(defun mastodon-profile--edit-string-value (key)
- "Edit the string for account preference KEY."
- (let* ((val (mastodon-profile--get-json-value key))
- (new-val (read-string (format "Edit account setting %s: " key)
- val)))
- (mastodon-profile--update-preference (symbol-name key) new-val)))
-
-(defun mastodon-profile-update-display-name ()
- "Update display name for your account."
- (interactive)
- (mastodon-profile--edit-string-value 'display_name))
-
-(defun mastodon-profile--make-meta-fields-params (fields)
- "Construct a parameter query string from metadata alist FIELDS.
-Returns an alist."
- (let ((keys
- (cl-loop
- for count from 1 to 5
- collect (cons (format "fields_attributes[%s][name]" count)
- (format "fields_attributes[%s][value]" count)))))
- (cl-loop for a-pair in keys
- for b-pair in fields
- append (list (cons (car a-pair) (car b-pair))
- (cons (cdr a-pair) (cdr b-pair))))))
-
-(defun mastodon-profile-update-meta-fields ()
- "Prompt for new metadata fields information and PATCH the server."
- (interactive)
- (let* ((url (mastodon-http--api "accounts/update_credentials"))
- (fields-updated (mastodon-profile--update-meta-fields-alist))
- (params (mastodon-profile--make-meta-fields-params fields-updated))
- (response (mastodon-http--patch url params)))
- (mastodon-http--triage response
- (lambda (_)
- (mastodon-profile--fetch-server-account-settings)
- (message "Metadata fields updated to %s!"
- fields-updated)))))
-
-(defun mastodon-profile--update-meta-fields-alist ()
- "Prompt for new metadata fields information.
-Returns the results as an alist."
- (let ((fields-old (mastodon-profile--fields-get
- nil ;; we must fetch the plaintext version:
- (mastodon-profile--get-source-value 'fields))))
- ;; offer empty fields if user currently has less than four filled:
- (while (< (length fields-old) 4)
- (setq fields-old (append fields-old '(("" . "")))))
- (let* ((f-str "Metadata %s [%s/4] (max. 255 chars): ")
- (alist
- (cl-loop for f in fields-old
- for x from 1 to 5
- collect
- (cons (read-string (format f-str "key" x) (car f))
- (read-string (format f-str "value" x) (cdr f))))))
- (mapcar (lambda (x)
- (cons (mastodon-profile--limit-to-255 (car x))
- (mastodon-profile--limit-to-255 (cdr x))))
- alist))))
-
-(defun mastodon-profile--limit-to-255 (x)
- "Limit string X to 255 chars max."
- (if (> (length x) 255) (substring x 0 255) x))
-
-;; used in tl.el and toot.el:
-(defun mastodon-profile--get-preferences-pref (pref)
- "Fetch PREF from the endpoint \"/preferences\".
-If `mastodon-profile-acccount-preferences-data' is set, fetch
-from that instead.
-The endpoint only holds a few preferences. For others, see
-`mastodon-profile--update-preference' and its endpoint,
-\"/accounts/update_credentials.\""
- (alist-get pref
- (or mastodon-profile-acccount-preferences-data
- (setq mastodon-profile-acccount-preferences-data
- (mastodon-http--get-json
- (mastodon-http--api "preferences"))))))
-
-(defun mastodon-profile-view-preferences ()
- "View user preferences in another window."
- (interactive)
- (let* ((url (mastodon-http--api "preferences"))
- (response (mastodon-http--get-json url))
- (buf (get-buffer-create "*mastodon-preferences*")))
- (with-mastodon-buffer buf #'special-mode :other-window
- (mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil)
- (while-let ((el (pop response)))
- (insert (format "%-30s %s"
- (prin1-to-string (car el))
- (prin1-to-string (cdr el)))
- "\n\n"))
- (goto-char (point-min)))))
-
-\f
-;;; PROFILE VIEW DETAILS
-
-(defun mastodon-profile--relationships-get (id)
- "Fetch info about logged-in user's relationship to user with id ID."
- (let* ((args `(("id[]" . ,id)))
- (url (mastodon-http--api "accounts/relationships")))
- ;; FIXME: API takes array, we just get 1st
- (car (mastodon-http--get-json url args))))
-
-(defun mastodon-profile--fields-get (&optional account fields)
- "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT.
-Returns an alist.
-FIELDS means provide a fields vector fetched by other means."
- (let ((fields (or fields (alist-get 'fields account))))
- (when 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."
- (let* ((car-fields (mapcar #'car fields))
- (left-width (apply #'max (mapcar #'length car-fields))))
- (mapconcat (lambda (field)
- (mastodon-tl--render-text
- (concat
- (format "_ %s " (car field))
- (make-string (- (+ 1 left-width) (length (car field))) ?_)
- (format " :: %s" (cdr field)))
- field)) ; hack to make links tabstops
- fields "")))
-
-(defun mastodon-profile--get-statuses-pinned (account)
- "Fetch the pinned toots for ACCOUNT."
- (let* ((id (alist-get 'id account))
- (args `(("pinned" . "true")))
- (url (mastodon-http--api (format "accounts/%s/statuses" id))))
- (mastodon-http--get-json url args)))
-
-(defun mastodon-profile--insert-statuses-pinned (pinned-statuses)
- "Insert each of the PINNED-STATUSES for a given account."
- (cl-loop for s in pinned-statuses
- do (progn
- (insert
- (concat "\n "
- (propertize " pinned "
- 'face '(:inherit success :box t))
- " "))
- (mastodon-tl--toot s))))
-
-(defun mastodon-profile--follows-p (list)
- "T if you have any relationship with the accounts in LIST."
- (let (result)
- (dolist (x list result)
- (when (not (eq :json-false x))
- (setq result x)))))
-
-(defun mastodon-profile--render-roles (roles)
- "Return a propertized string of badges for ROLES."
- (mapconcat
- (lambda (role)
- (propertize (alist-get 'name role)
- 'face `(:box t :foreground ,(alist-get 'color role))))
- roles))
-
-(defun mastodon-profile--render-moved (data)
- "Return a propertized string of a migrated account link.
-DATA is an account data from a moved field in profile data."
- (let-alist data
- (let ((handle (concat "@" .acct)))
- (concat
- "this account has migrated to: "
- (mastodon-tl--buttonify-link
- handle
- 'face 'shr-link ;'mastodon-handle-face
- 'mastodon-tab-stop 'user-handle
- 'shr-url .url
- 'mastodon-handle handle
- 'help-echo (concat "Browse user profile of " handle))
- "\n\n"))))
-
-(defun mastodon-profile--make-profile-buffer-for
- (account endpoint-type update-function
- &optional no-reblogs headers no-replies only-media tag max-id)
- "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION.
-NO-REBLOGS means do not display boosts in statuses.
-HEADERS means also fetch link headers for pagination.
-NO-REPLIES means to exlude replies.
-ONLY-MEDIA means show only posts containing attachments.
-TAG is a hashtag to restrict posts to.
-MAX-ID is a flag to include the max_id pagination parameter."
- (let-alist account
- (let* ((max-id-str (when max-id
- (mastodon-tl--buffer-property 'max-id)))
- (args `(("limit" . ,mastodon-tl--timeline-posts-count)
- ,(when max-id `("max_id" . ,max-id-str))))
- (args (cond (no-reblogs
- (push '("exclude_reblogs" . "t") args))
- (no-replies
- (push '("exclude_replies" . "t") args))
- (only-media
- (push '("only_media" . "t") args))
- (tag
- (push `("tagged" . ,tag) args))
- (t args)))
- (endpoint (format "accounts/%s/%s" .id endpoint-type))
- (url (mastodon-http--api endpoint))
- (buffer (concat "*mastodon-" .acct "-"
- (concat endpoint-type
- (cond (no-reblogs "-no-boosts")
- (no-replies "-no-replies")
- (only-media "-only-media")
- (tag (format "-tagged-%s" tag))
- (t "")))
- "*"))
- (response (if headers
- (mastodon-http--get-response url args)
- (mastodon-http--get-json url args)))
- (json (if headers (car response) response))
- (link-header (when headers
- (mastodon-tl--get-link-header-from-response
- (cdr response))))
- (fields (mastodon-profile--fields-get account))
- (pinned (mastodon-profile--get-statuses-pinned account))
- (relationships (mastodon-profile--relationships-get .id)))
- (with-mastodon-buffer buffer #'mastodon-mode nil
- (mastodon-profile-mode)
- (setq mastodon-profile--account account)
- (mastodon-tl--set-buffer-spec buffer endpoint update-function
- link-header args nil max-id-str)
- (let* ((inhibit-read-only t))
- (insert
- (propertize
- (concat
- "\n"
- (mastodon-profile--image-from-account account 'avatar_static)
- (mastodon-profile--image-from-account account 'header_static)
- "\n"
- (when .display_name
- (propertize (if (string-empty-p .display_name)
- .username
- .display_name)
- 'face 'mastodon-display-name-face))
- ;; roles
- (when .roles
- (concat " " (mastodon-profile--render-roles .roles)))
- "\n"
- (propertize (concat "@" .acct) 'face 'default)
- (when (eq .locked t)
- (concat " " (mastodon-tl--symbol 'locked)))
- "\n " mastodon-tl--horiz-bar "\n"
- ;; migration:
- (when .moved
- (mastodon-profile--render-moved .moved))
- ;; profile note:
- (mastodon-tl--render-text .note account) ; account = tab-stops in profile
- ;; meta fields:
- (when fields
- (concat "\n" (mastodon-tl--set-face
- (mastodon-profile--fields-insert fields)
- 'success)))
- "\n"
- ;; Joined date:
- (propertize
- (mastodon-profile--format-joined-date-string .created_at)
- 'face 'success)
- "\n\n")
- 'profile-json account)
- ;; insert counts
- (mastodon-tl--set-face
- (concat " " mastodon-tl--horiz-bar "\n"
- " TOOTS: " (mastodon-tl--as-string .statuses_count) " | "
- "FOLLOWERS: " (mastodon-tl--as-string .followers_count) " | "
- "FOLLOWING: " (mastodon-tl--as-string .following_count) "\n"
- " " mastodon-tl--horiz-bar "\n\n")
- 'success)
- ;; insert relationship (follows)
- (let-alist relationships
- (if (not .id)
- ;; sharkey has no relationships endpoint, returns 500.
- ;; or poss it has a different endpoint
- ""
- (let* ((followsp (mastodon-profile--follows-p
- (list .requested_by .following .followed_by .blocked_by)))
- (rels (mastodon-profile--relationships-get .id))
- (langs-filtered (if-let* ((langs (alist-get 'languages rels)))
- (concat " ("
- (mapconcat #'identity langs " ")
- ")")
- "")))
- (if followsp
- (mastodon-tl--set-face
- (concat (when (eq .following t)
- (format " | FOLLOWED BY YOU%s" langs-filtered))
- (when (eq .followed_by t)
- " | FOLLOWS YOU")
- (when (eq .requested_by t)
- " | REQUESTED TO FOLLOW YOU")
- (when (eq .blocked_by t)
- " | BLOCKS YOU")
- "\n\n")
- 'success)
- ""))))) ; for insert call
- (mastodon-media--inline-images (point-min) (point))
- ;; widget items description
- (mastodon-widget--create
- "View" (mastodon-profile--view-types)
- (or (mastodon-profile--current-view-type
- endpoint-type no-reblogs no-replies only-media tag)
- 'statuses)
- (lambda (widget &rest _ignore)
- (let ((value (widget-value widget)))
- (funcall
- (alist-get value
- mastodon-profile--account-view-alist)))))
- (insert "\n")
- (setq mastodon-tl--update-point (point))))
- ;; split insert of items from insert of profile:
- (with-current-buffer buffer
- (let* ((inhibit-read-only t))
- ;; insert pinned toots first
- (when (and pinned (string= endpoint-type "statuses"))
- (let ((beg (point)))
- (mastodon-profile--insert-statuses-pinned pinned)
- (setq mastodon-tl--update-point (point))
- (mastodon-media--inline-images beg (point)))) ; updates after pinned toots
- ;; insert items
- (funcall update-function json)
- (goto-char (point-min))
- (message
- (substitute-command-keys
- ;; "\\[mastodon-profile-account-view-cycle]" ; not always bound?
- "\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\
- only media, followers, following.
-\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag.")))))))
-
-(defun mastodon-profile--current-view-type (type no-reblogs no-replies
- only-media tag)
- "Return the type of current profile view.
-Return a member of `mastodon-profile--view-types', based on TYPE,
-NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG."
- (cond (no-reblogs 'no-boosts)
- (no-replies 'no-replies)
- (only-media 'only-media)
- (tag 'tag)
- (t (if (stringp type) (intern type) type))))
-
-(defun mastodon-profile--format-joined-date-string (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)))
-
-(defun mastodon-profile-get-toot-author (&optional max-id)
- "Open profile of author of toot under point.
-If toot is a boost, load the profile of the author of the original item.
-MAX-ID is a flag to include the max_id pagination parameter."
- (interactive)
- (mastodon-tl--do-if-item
- (let ((json (mastodon-tl--toot-or-base
- (mastodon-profile--item-json))))
- (mastodon-profile--make-author-buffer
- (alist-get 'account json)
- nil nil nil nil max-id))))
-
-(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)))
- (unless (string= img "/avatars/original/missing.png")
- (mastodon-media--get-media-link-rendering img))))
-
-(defun mastodon-profile-show-user (user-handle)
- "Query for USER-HANDLE from current status and show that user's profile."
- (interactive
- (list
- (if (and (not (mastodon-tl--profile-buffer-p))
- (not (mastodon-tl--property 'item-json :no-move)))
- (user-error "Looks like there's no toot or user at point?")
- (let ((user-handles (mastodon-profile--extract-users-handles
- (mastodon-profile--item-json))))
- (completing-read "View profile of user [choose or enter any handle]: "
- user-handles
- nil ; predicate
- 'confirm)))))
- (if (not (or ; own profile has no need for item-json test:
- (string= user-handle (mastodon-auth--get-account-name))
- (mastodon-tl--profile-buffer-p)
- (mastodon-tl--property 'item-json :no-move)))
- (user-error "Looks like there's no toot or user at point?")
- (let ((account (mastodon-profile--lookup-account-in-status
- user-handle (mastodon-profile--item-json))))
- (if (not account)
- (user-error "Cannot find a user with handle %S" user-handle)
- (progn
- (message "Loading profile of user %s..." user-handle)
- (mastodon-profile--make-author-buffer account))))))
-
-(defun mastodon-profile-my-profile ()
- "Show the profile of the currently signed in user."
- (interactive)
- (message "Loading your profile...")
- (let ((account (mastodon-profile--account-from-id
- (mastodon-auth--get-account-id))))
- (mastodon-profile--make-author-buffer account)))
-
-(defun mastodon-profile--format-user (tootv)
- "Convert TOOTV into author-bylines and insert.
-Also insert their profile note.
-Used to view a user's followers and those they're following."
- (let ((inhibit-read-only t))
- (unless (seq-empty-p tootv)
- (mapc
- (lambda (toot)
- (let ((start-pos (point)))
- (insert
- "\n"
- (propertize
- (mastodon-tl--byline-author `((account . ,toot)) :avatar nil :base)
- 'byline 't
- 'item-id (alist-get 'id toot)
- 'base-item-id (mastodon-tl--item-id toot)
- 'item-json toot))
- (mastodon-media--inline-images start-pos (point))
- (insert "\n"
- (propertize
- (mastodon-tl--render-text (alist-get 'note toot) nil)
- 'item-json toot)
- "\n")))
- tootv))))
-
-(defun mastodon-profile--search-account-by-handle (handle)
- "Return an account based on a user's HANDLE.
-If the handle does not match a search return then retun NIL."
- (let* ((handle (if (string= "@" (substring handle 0 1))
- (substring handle 1 (length handle))
- handle))
- (args `(("q" . ,handle)
- ("type" . "accounts")))
- (result (mastodon-http--get-json
- (mastodon-http--api-v2 "search") args))
- (matching-account (seq-remove
- (lambda (x)
- (not (string= handle (alist-get 'acct x))))
- (alist-get 'accounts result))))
- (when (eq 1 (length matching-account))
- (elt matching-account 0))))
-
-(defun mastodon-profile--account-from-id (user-id)
- "Request an account object relating to a USER-ID."
- (mastodon-http--get-json
- (mastodon-http--api (format "accounts/%s" user-id))))
-
-(defun mastodon-profile--extract-users-handles (status)
- "Return all user handles found in STATUS.
-These include the author, author of reblogged entries and any user mentioned."
- (when status
- (let ((this-account (or (alist-get 'account status) ; status is a toot
- status)) ; status is a user listing
- (mentions (mastodon-tl--field-status 'mentions status))
- (reblog (mastodon-tl--field-status 'reblog status)))
- (seq-remove
- (lambda (x) (string= x mastodon-active-user))
- (seq-filter #'stringp
- (seq-uniq
- (seq-concatenate
- 'list
- (list (alist-get 'acct this-account))
- (mastodon-profile--extract-users-handles reblog)
- (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."
- (let* ((this-account (alist-get 'account status))
- (reblog-account (alist-get 'account (alist-get 'reblog status)))
- (mention-id (seq-some
- (lambda (mention)
- (when (string= handle (alist-get 'acct mention))
- (alist-get 'id mention)))
- (alist-get 'mentions status))))
- (cond ((string= handle (alist-get 'acct this-account))
- this-account)
- ((string= handle (alist-get 'acct reblog-account))
- reblog-account)
- (mention-id
- (mastodon-profile--account-from-id mention-id))
- (t
- (mastodon-profile--search-account-by-handle handle)))))
-
-;;; REMOVE
-
-(defun mastodon-profile-remove-user-from-followers (&optional id)
- "Remove a user from your followers.
-Optionally provide the ID of the account to remove."
- (interactive)
- (let* ((account (unless id (mastodon-tl--property 'item-json :no-move)))
- (id (or id (alist-get 'id account)))
- (handle (let ((account (or account
- (mastodon-profile--account-from-id id))))
- (alist-get 'acct account)))
- (url (mastodon-http--api
- (format "accounts/%s/remove_from_followers" id))))
- (when (y-or-n-p (format "Remove follower %s? " handle))
- (let ((response (mastodon-http--post url)))
- (mastodon-http--triage response
- (lambda (_)
- (message "Follower %s removed!" handle)))))))
-
-(defun mastodon-profile-remove-from-followers-at-point ()
- "Prompt for a user in the item at point and remove from followers."
- (interactive)
- (let* ((handles (mastodon-profile--extract-users-handles
- (mastodon-profile--item-json)))
- (handle (completing-read "Remove from followers: " handles))
- (account (mastodon-profile--lookup-account-in-status
- handle (mastodon-profile--item-json)))
- (id (alist-get 'id account)))
- (mastodon-profile-remove-user-from-followers id)))
-
-(defun mastodon-profile-remove-from-followers-list ()
- "Select a user from your followers and remove from followers.
-Currently limited to 100 handles. If not found, try
-`mastodon-search-query'."
- (interactive)
- (let* ((endpoint (format "accounts/%s/followers"
- (mastodon-auth--get-account-id)))
- (url (mastodon-http--api endpoint))
- (response (mastodon-http--get-json url `(("limit" . "100"))))
- (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response))
- (choice (completing-read "Remove from followers: " handles))
- (id (alist-get choice handles)))
- (mastodon-profile-remove-user-from-followers id)))
-
-;;; PRIVATE NOTES
-
-(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."
- (if (not (mastodon-tl--profile-buffer-p))
- (error "Not viewing a profile")
- (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--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--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)
- (user-error "No private note for %s" handle)
- ;; `mastodon-profile--display-private-note' takes 1 arg:
- (funcall action-fun note))
- ;; `mastodon-profile--post-private-note-to-account' takes 3 args:
- (funcall action-fun id handle note))))
-
-;;; FAMILIAR FOLLOWERS
-
-(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--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 handles multiple IDs, but 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
- (handles (mastodon-tl--map-alist 'acct accounts)))
- (if (null handles)
- (user-error "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
+++ /dev/null
-;;; mastodon-search.el --- Search functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Marty Hiatt
-;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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:
-
-;; A basic search function for mastodon.el
-
-;;; Code:
-(require 'json)
-(require 'mastodon-tl)
-(require 'mastodon-widget)
-
-(autoload 'mastodon-auth--access-token "mastodon-auth")
-(autoload 'mastodon-http--api "mastodon-http")
-(autoload 'mastodon-http--get-json "mastodon-http")
-(autoload 'mastodon-http--get-search-json "mastodon-http")
-(autoload 'mastodon-mode "mastodon")
-(autoload 'mastodon-tl--as-string "mastodon-tl")
-(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")
-(autoload 'mastodon-tl--timeline "mastodon-tl")
-(autoload 'mastodon-tl--toot "mastodon-tl")
-(autoload 'mastodon-tl--buffer-property "mastodon-tl")
-(autoload 'mastodon-http--api-v2 "mastodon-http")
-
-(defvar mastodon-toot--completion-style-for-mentions)
-(defvar mastodon-instance-url)
-(defvar mastodon-tl--link-keymap)
-(defvar mastodon-tl--horiz-bar)
-
-;; functions for completion of mentions in mastodon-toot
-
-(defun mastodon-search--get-user-info-@ (account)
- "Get user handle, display name and account URL from ACCOUNT."
- (list (concat "@" (cdr (assoc 'acct account)))
- (cdr (assoc 'url account))
- (cdr (assoc 'display_name account))))
-
-(defun mastodon-search--search-accounts-query (query)
- "Prompt for a search QUERY and return accounts synchronously.
-Returns a nested list containing user handle, display name, and URL."
- (let* ((url (mastodon-http--api "accounts/search"))
- (response
- (mastodon-http--get-json
- url
- `(("q" . ,query) ;; NB: nil can break params (but works for me)
- ,(when (string= "following"
- mastodon-toot--completion-style-for-mentions)
- '("following" . "true")))
- :silent)))
- (mapcar #'mastodon-search--get-user-info-@ response)))
-
-;; functions for tags completion:
-
-(defun mastodon-search--search-tags-query (query)
- "Return an alist containing tag strings plus their URLs.
-QUERY is the string to search."
- (let* ((url (mastodon-http--api-v2 "search"))
- (params `(("q" . ,query) ("type" . "hashtags")))
- (response (mastodon-http--get-json url params :silent))
- (tags (alist-get 'hashtags response)))
- (mapcar #'mastodon-search--get-hashtag-info tags)))
-
-;; trending tags
-
-(defun mastodon-search-trending-tags ()
- "Display a list of tags trending on your instance."
- (interactive)
- (mastodon-search--view-trending "tags"
- #'mastodon-search--print-tags))
-
-(defun mastodon-search-trending-statuses ()
- "Display a list of statuses trending on your instance."
- (interactive)
- (mastodon-search--view-trending "statuses"
- #'mastodon-tl--timeline))
-
-(defun mastodon-search-trending-links ()
- "Display a list of links trending on your instance."
- (interactive)
- (mastodon-search--view-trending "links"
- #'mastodon-search--render-links))
-
-(defun mastodon-search--render-links (links)
- "Render trending LINKS."
- (cl-loop for l in links
- do (mastodon-search--render-link l)))
-
-(defun mastodon-search--render-link (link)
- "Render a trending LINK."
- (let-alist link
- (insert
- (propertize
- (mastodon-tl--render-text
- (concat "<a href=\"" .url "\">" .url "</a>\n" .title)
- link)
- 'item-type 'link
- 'item-json link
- 'shr-url .url
- 'byline t ;; nav
- 'help-echo
- (substitute-command-keys
- "\\[`mastodon-search-load-link-posts'] to view a link's timeline"))
- ;; TODO: display card link author here
- "\n\n")))
-
-(defun mastodon-search-load-link-posts ()
- "Load timeline of posts containing link at point."
- (interactive)
- (let* ((url (mastodon-tl--property 'shr-url)))
- (mastodon-tl--link-timeline url)))
-
-(defun mastodon-search--view-trending (type print-fun)
- "Display a list of tags trending on your instance.
-TYPE is a string, either tags, statuses, or links.
-PRINT-FUN is the function used to print the data from the response."
- (let* ((url (mastodon-http--api (format "trends/%s" type)))
- ;; max for statuses = 40, for others = 20
- (limit (if (string= type "statuses")
- '("limit" . "40")
- '("limit" . "20")))
- (offset '(("offset" . "0")))
- (params (push limit offset))
- (data (mastodon-http--get-json url params))
- (buffer (get-buffer-create
- (format "*mastodon-trending-%s*" type))))
- (with-mastodon-buffer buffer #'mastodon-mode nil
- (mastodon-tl--set-buffer-spec (buffer-name buffer)
- (format "trends/%s" type)
- print-fun nil params)
- (mastodon-search--insert-heading "trending" type)
- (funcall print-fun data)
- (unless (string= type "statuses")
- (goto-char (point-min))))))
-
-;; functions for mastodon search
-
-(defun mastodon-search--insert-heading (str &optional type)
- "Insert STR as a heading.
-Optionally add string TYPE after HEADING."
- (insert
- (mastodon-search--format-heading str type)))
-
-(defun mastodon-search--format-heading (str &optional type no-newline)
- "Format STR as a heading.
-Optionally add string TYPE after HEADING.
-NO-NEWLINE means don't add add a newline at end."
- (mastodon-tl--set-face
- (concat "\n " mastodon-tl--horiz-bar "\n "
- (upcase str) " "
- (when type (upcase type)) "\n"
- " " mastodon-tl--horiz-bar (unless no-newline "\n"))
- 'success))
-
-(defvar mastodon-search-types
- '("statuses" "accounts" "hashtags"))
-
-(defun mastodon-search-query (query &optional type limit
- following account-id offset)
- "Prompt for a search QUERY and return accounts, statuses, and hashtags.
-TYPE is a member of `mastodon-search-types'.
-LIMIT is a number as string, up to 40, with 40 the default.
-FOLLOWING means limit to accounts followed, for \"accounts\" type only.
-A single prefix arg also sets FOLLOWING to true.
-ACCOUNT-ID means limit search to that account, for \"statuses\" type only.
-OFFSET is a number as string, means to skip that many results. It
-is used for pagination."
- ;; TODO: handle no results
- (interactive "sSearch mastodon for: ")
- (let* ((url (mastodon-http--api-v2 "search"))
- (following (when (or following (equal current-prefix-arg '(4)))
- "true"))
- (type (or type
- (if (equal current-prefix-arg '(4))
- "accounts" ; if FOLLOWING, must be "accounts"
- (completing-read "Search type: "
- mastodon-search-types nil :match))))
- (limit (or limit "40"))
- (offset (or offset "0"))
- (buffer (format "*mastodon-search-%s-%s*" type query))
- (params `(("q" . ,query)
- ,@(when type `(("type" . ,type)))
- ,@(when limit `(("limit" . ,limit)))
- ,@(when offset `(("offset" . ,offset)))
- ,@(when following `(("following" . ,following)))
- ,@(when account-id `(("account_id" . ,account-id)))))
- (response (mastodon-http--get-json url params))
- (items (alist-get (intern type) response)))
- (with-mastodon-buffer buffer #'mastodon-mode nil
- (mastodon-search-mode)
- (mastodon-search--insert-heading "search")
- (mastodon-widget--create
- "Results"
- '(accounts hashtags statuses)
- (intern type)
- (lambda (widget &rest _ignore)
- (let ((value (widget-value widget)))
- (mastodon-search-query query (symbol-name value)))))
- (insert "\n\n")
- (cond ((string= type "accounts")
- (mastodon-search--render-response items type buffer params
- 'mastodon-views--insert-users-propertized-note
- 'mastodon-views--insert-users-propertized-note))
- ((string= type "hashtags")
- (mastodon-search--render-response items type buffer params
- 'mastodon-search--print-tags
- 'mastodon-search--print-tags))
- ((string= type "statuses")
- (mastodon-search--render-response items type buffer params
- #'mastodon-tl--timeline
- #'mastodon-tl--timeline)))
- (goto-char (point-min))
- (message
- (substitute-command-keys
- "\\[mastodon-search-query-cycle] to cycle result types.")))))
-
-(defun mastodon-search-insert-no-results (&optional thing)
- "Insert a no results message for object THING."
- (let ((thing (or thing "items")))
- (insert
- (propertize (format "Looks like search returned no %s." thing)
- 'face 'mastodon-toot-docs-face))))
-
-(defun mastodon-search--render-response (data type buffer params
- insert-fun update-fun)
- "Call INSERT-FUN on DATA of result TYPE if non-nil.
-BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'."
- (if (not data)
- (mastodon-search-insert-no-results type)
- (funcall insert-fun data))
- (mastodon-tl--set-buffer-spec buffer "search"
- update-fun nil params))
-
-(defun mastodon-search--buf-type ()
- "Return search buffer type, a member of `mastodon-search-types'."
- ;; called in `mastodon-tl--get-buffer-type'
- (let* ((spec (mastodon-tl--buffer-property 'update-params)))
- (alist-get "type" spec nil nil #'string=)))
-
-(defun mastodon-search-query-cycle ()
- "Cycle through search types: accounts, hashtags, and statuses."
- (interactive)
- (let* ((spec (mastodon-tl--buffer-property 'update-params))
- (type (alist-get "type" spec nil nil #'string=))
- (query (alist-get "q" spec nil nil #'string=)))
- (cond ((string= type "hashtags")
- (mastodon-search-query query "accounts"))
- ((string= type "accounts")
- (mastodon-search-query query "statuses"))
- ((string= type "statuses")
- (mastodon-search-query query "hashtags")))))
-
-(defun mastodon-search-query-accounts-followed (query)
- "Run an accounts search QUERY, limited to your followers."
- (interactive "sSearch mastodon for: ")
- (mastodon-search-query query "accounts" :following))
-
-(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'."
- (cl-loop for acct in json
- do (insert (concat (mastodon-search--propertize-user acct note)
- mastodon-tl--horiz-bar
- "\n\n"))))
-
-(defun mastodon-search--propertize-user (acct &optional note)
- "Propertize display string for ACCT, optionally including profile NOTE."
- (let* ((user (mastodon-search--get-user-info acct))
- (id (alist-get 'id acct)))
- (propertize
- (concat
- (propertize (car user)
- 'face 'mastodon-display-name-face
- 'byline t
- 'item-type 'user
- 'item-id id) ; for prev/next nav
- " : \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"
- (when note
- (mastodon-tl--render-text (cadddr user) acct))
- "\n")
- 'item-json acct))) ; for compat w other processing functions
-
-(defun mastodon-search--print-tags (tags)
- "Print TAGS data as returned from a \"hashtags\" search query."
- (let ((tags-list (mapcar #'mastodon-search--get-hashtag-info tags)))
- (mastodon-search--print-tags-list tags-list)))
-
-(defun mastodon-search--print-tags-list (tags-list)
- "Insert a propertized list of TAGS-LIST."
- (cl-loop for el in tags-list
- do (insert
- " : "
- (propertize (concat "#" (car el))
- 'face '(:box t)
- 'mouse-face 'highlight
- 'mastodon-tag (car el)
- 'mastodon-tab-stop 'hashtag
- 'item-type 'tag ; for next/prev nav
- 'byline t ; for next/prev nav
- 'help-echo (concat "Browse tag #" (car el))
- 'keymap mastodon-tl--link-keymap)
- " : \n\n")))
-
-(defun mastodon-search--get-user-info (account)
- "Get user handle, display name, account URL and profile note from ACCOUNT."
- (list (mastodon-tl--display-or-uname account)
- (alist-get 'acct account)
- (alist-get 'url account)
- (alist-get 'note account)))
-
-(defun mastodon-search--get-hashtag-info (tag)
- "Get hashtag name and URL from TAG."
- (list (alist-get 'name tag)
- (alist-get 'url tag)))
-
-;; These functions are all unused!
-
-;; (defun mastodon-search--get-status-info (status)
-;; "Get ID, timestamp, content, and spoiler from STATUS."
-;; (list (alist-get 'id status)
-;; (alist-get 'created_at status)
-;; (alist-get 'spoiler_text status)
-;; (alist-get 'content status)))
-
-;; (defun mastodon-search--id-from-status (status)
-;; "Fetch the id from a STATUS returned by a search call to the server.
-;; We use this to fetch the complete status from the server."
-;; (alist-get 'id status))
-
-;; (defun mastodon-search--full-status-from-id (id)
-;; "Fetch the full status with id ID from the server.
-;; This allows us to access the full account etc. details and to
-;; render them properly."
-;; (let* ((url (mastodon-http--api (format "statuses/%s" id)))
-;; ;; (concat mastodon-instance-url "/api/v1/statuses/"
-;; ;; (mastodon-tl--as-string id)))
-;; (json (mastodon-http--get-json url)))
-;; json))
-
-(defvar mastodon-search-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") #'mastodon-search-query-cycle)
- map)
- "Keymap for `mastodon-search-mode'.")
-
-(define-minor-mode mastodon-search-mode
- "Toggle mastodon search minor mode.
-This minor mode is used for mastodon search pages to adds a keybinding."
- :init-value nil
- :lighter " Search"
- :keymap mastodon-search-mode-map
- :group 'mastodon
- :global nil)
-
-(provide 'mastodon-search)
-;;; mastodon-search.el ends here
+++ /dev/null
-;;; mastodon-tl.el --- Timeline functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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-tl.el provides timeline functions.
-
-;;; Code:
-
-(require 'shr)
-(require 'thingatpt) ; for word-at-point
-(require 'time-date)
-(require 'cl-lib)
-(require 'mastodon-iso)
-(require 'mpv nil :no-error)
-(require 'url-cache)
-
-(autoload 'mastodon-mode "mastodon")
-(autoload 'mastodon-notifications-get "mastodon")
-(autoload 'mastodon-url-lookup "mastodon")
-(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-notifications--filter-types-list "mastodon-notifications")
-(autoload 'mastodon-notifications-get-mentions "mastodon-notifications")
-(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-open-statuses-no-reblogs "mastodon-profile")
-(autoload 'mastodon-profile--profile-json "mastodon-profile")
-(autoload 'mastodon-profile--search-account-by-handle "mastodon-profile")
-(autoload 'mastodon-profile--item-json "mastodon-profile")
-(autoload 'mastodon-profile--view-author-profile "mastodon-profile")
-(autoload 'mastodon-profile-mode "mastodon-profile")
-(autoload 'mastodon-search--get-user-info "mastodon-search")
-(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-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-search--buf-type "mastodon-search")
-(autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ; for search pagination
-(autoload 'mastodon-http--get-response "mastodon-http")
-(autoload 'mastodon-search--insert-heading "mastodon-search")
-(autoload 'mastodon-media--process-full-sized-image-response "mastodon-media")
-(autoload 'mastodon-search-trending-statuses "mastodon-search")
-(autoload 'mastodon-search--format-heading "mastodon-search")
-(autoload 'mastodon-media--image-or-cached "mastodon-media")
-(autoload 'mastodon-toot--base-toot-or-item-json "mastodon-toot")
-(autoload 'mastodon-search-load-link-posts "mastodon-search")
-(autoload 'mastodon-notifications--current-type "mastodon-notifications")
-(autoload 'mastodon-notifications--timeline "mastodon-notifications")
-(autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications")
-(autoload 'mastodon-search--print-tags "mastodon-search")
-(autoload 'mastodon-profile-show-user "mastodon-profile")
-
-(defvar mastodon-toot--visibility)
-(defvar mastodon-toot-mode)
-(defvar mastodon-active-user)
-(defvar mastodon-images-in-notifs)
-(defvar mastodon-group-notifications)
-
-(when (require 'mpv nil :no-error)
- (declare-function mpv-start "mpv"))
-(defvar mastodon-mode-map)
-(defvar mastodon-instance-url)
-(defvar mastodon-toot-timestamp-format)
-(defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this
-(defvar mastodon-media--enable-image-caching)
-(defvar mastodon-media--generic-broken-image-data)
-(defvar mastodon-media--sensitive-image-data)
-(defvar mastodon-media--attachments)
-
-\f
-;;; CUSTOMIZES
-
-(defgroup mastodon-tl nil
- "Timelines in Mastodon."
- :prefix "mastodon-tl-"
- :group 'mastodon)
-
-(defcustom mastodon-tl--enable-relative-timestamps t
- "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."
- :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."
- :type '(boolean :tag "Enable using proportional rather than fixed \
-width fonts when rendering HTML text"))
-
-(defcustom mastodon-tl--no-fill-on-render nil
- "Non-nil to disable filling by shr.el while rendering toot body.
-Use this if your setup isn't compatible with shr's window width filling."
- :type '(boolean))
-
-(defcustom mastodon-tl--display-media-p t
- "A boolean value stating whether to show media in timelines."
- :type 'boolean)
-
-(defcustom mastodon-tl--display-caption-not-url-when-no-media t
- "Display an image's caption rather than URL.
-Only has an effect when `mastodon-tl--display-media-p' is set to
-nil."
- :type 'boolean)
-
-(defcustom mastodon-tl--show-avatars nil
- "Whether to enable display of user avatars in timelines."
- :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 'boolean)
-
-(defcustom mastodon-tl--symbols
- `((reply . ("💬" . "R"))
- (boost . ("🔁" . "B"))
- (reblog . ("🔁" . "B")) ;; server compat
- (favourite . ("⭐" . "F"))
- (bookmark . ("🔖" . "K"))
- (media . ("📹" . "[media]"))
- (verified . ("✓" . "V"))
- (locked . ("🔒" . "[locked]"))
- (private . ("🔒" . "[followers]"))
- (mention . ("@" . "[mention]"))
- (direct . ("✉" . "[direct]"))
- (edited . ("✍" . "[edited]"))
- (update . ("✍" . "[edited]")) ;; server compat
- (status . ("🔔" . "[posted]"))
- (replied . ("⬇" . "↓"))
- (reply-bar . ("┃" . "|"))
- (poll . ("📊" . "[poll]"))
- (follow . ("👤" . "+"))
- (follow_request . ("👤" . "+"))
- (severed_relationships . ("🔗" . "//"))
- (moderation_warning . ("⚠" . "!!"))
- (quote . (,(propertize "“" 'face
- '(t :inherit success :weight bold
- :height 1.8))))
- (quoted_update . ("✍" . "[edited]")))
- "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 (cons string string)))
-
-(defcustom mastodon-tl-position-after-update nil
- "Defines where `point' should be located after a timeline update.
-Valid values are:
-- nil Top/bottom depending on timeline type
-- keep-point Keep original position of point
-- last-old-toot The last toot before the new ones"
- :type '(choice (const :tag "Top/bottom depending on timeline type" nil)
- (const :tag "Keep original position of point" keep-point)
- (const :tag "The last toot before the new ones" last-old-toot)))
-
-(defcustom mastodon-tl--timeline-posts-count "20"
- "Number of posts to display when loading a timeline.
-Must be an integer between 20 and 40 inclusive."
- :type '(string))
-
-(defcustom mastodon-tl--hide-replies nil
- "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'."
- :type '(boolean :tag "Whether to hide replies from the timelines."))
-
-(defcustom mastodon-tl--highlight-current-toot nil
- "Whether to highlight the toot at point. Uses `cursor-face' special property."
- :type '(boolean))
-
-(defcustom mastodon-tl--expand-content-warnings 'server
- "Whether to expand content warnings by default.
-The API returns data about this setting on the server, but no
-means to set it, so we roll our own option here to override the
-server setting if desired. If you change the server setting and
-want it to be respected by mastodon.el, you'll likely need to
-either unset `mastodon-profile-acccount-preferences-data' and
-re-load mastodon.el, or restart Emacs."
- :type '(choice (const :tag "true" t)
- (const :tag "false" nil)
- (const :tag "follow server setting" server)))
-
-(defcustom mastodon-tl--tag-timeline-tags nil
- "A list of up to four tags for use with `mastodon-tl-followed-tags-timeline'."
- :type '(repeat string))
-
-(defcustom mastodon-tl--load-full-sized-images-in-emacs t
- "Whether to load full-sized images inside Emacs.
-Full-sized images are loaded when you hit return on or click on
-an image in a timeline.
-If nil, mastodon.el will instead call `shr-browse-image', which
-respects the user's `browse-url' settings."
- :type '(boolean))
-
-(defcustom mastodon-tl--remote-local-domains nil
- "A list of domains to view the local timelines of.
-See `mastodon-tl-get-remote-local-timeline' for view remote local domains."
- :type '(repeat string))
-
-(defcustom mastodon-tl--fold-toots-at-length 1200
- "Length, in characters, to fold a toot at.
-Longer toots will be folded and the remainder replaced by a
-\"read more\" button. If the value is nil, don't fold at all."
- :type '(integer))
-
-\f
-;;; 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.")
-
-(defvar-local mastodon-tl--after-update-marker nil
- "Marker defining the position of point after the update is done.")
-
-(defvar-local mastodon-tl--timestamp-next-update nil
- "The timestamp when the buffer should next be scanned to update the timestamps.")
-
-(defvar-local mastodon-tl--timestamp-update-timer nil
- "The timer that, when set will scan the buffer to update the timestamps.")
-
-(defvar mastodon-tl--horiz-bar
- (make-string 12
- (if (char-displayable-p ?―) ?― ?-)))
-
-\f
-;;; 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)
- 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 (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)
- ;; keep new my-profile binding; shr 'O' doesn't work here anyway
- (define-key map (kbd "O") #'mastodon-profile-my-profile)
- ;; 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 [remap shr-browse-url] #'mastodon-url-lookup)
- (define-key map (kbd "M-RET") #'mastodon-search-load-link-posts)
- 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 (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)
- ;; 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] #'mastodon-tl-view-full-image-or-play-video)
- ;; 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)
- ;; 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") #'mastodon-tl-copy-image-caption)
- (define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image)
- (define-key map (kbd "<C-return>") #'mastodon-tl-mpv-play-video-at-point)
- (define-key map (kbd "<mouse-2>") #'mastodon-tl-click-image-or-video)
- 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--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 "RET") #'mastodon-profile-get-toot-author)
- (define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image)
- map))
- "The keymap to be set for the author byline.
-It is active where point is placed by `mastodon-tl-goto-next-item.'")
-
-(require 'image-mode)
-
-(defvar mastodon-image-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map image-mode-map)
- (define-key map (kbd ">") #'mastodon-tl-next-full-image)
- (define-key map (kbd "<") #'mastodon-tl-prev-full-image)
- (define-key map (kbd ".") #'mastodon-tl-next-full-image)
- (define-key map (kbd ",") #'mastodon-tl-prev-full-image)
- ;; matches view full image binding in main keymap:
- (define-key map (kbd "=") #'mastodon-tl-next-full-image)
- (define-key map (kbd "-") #'mastodon-tl-prev-full-image)
- (define-key map (kbd "<right>") #'mastodon-tl-next-full-image)
- (define-key map (kbd "<left>") #'mastodon-tl-prev-full-image)
- map))
-
-\f
-;;; MACROS
-
-(defmacro with-mastodon-buffer (buffer mode-fun other-window &rest body)
- "Evaluate BODY in a new or existing buffer called BUFFER.
-MODE-FUN is called to set the major mode.
-OTHER-WINDOW means call `switch-to-buffer-other-window' rather
-than `pop-to-buffer'."
- (declare (debug t)
- (indent 3))
- `(with-current-buffer (get-buffer-create ,buffer)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (funcall ,mode-fun)
- (remove-overlays) ; video overlays
- ,@body
- ;; return result of switching buffer:
- (if ,other-window
- (switch-to-buffer-other-window ,buffer)
- (pop-to-buffer ,buffer '(display-buffer-same-window))))))
-
-(defmacro mastodon-tl--do-if-item (&rest body)
- "Execute BODY if we have an item at point."
- (declare (debug t))
- `(if (and (not (mastodon-tl--profile-buffer-p))
- (not (mastodon-tl--property 'item-json))) ; includes users but not tags
- (user-error "Looks like there's no item at point?")
- ,@body))
-
-\f
-;;; NAV
-
-(defun mastodon-tl-scroll-up-command ()
- "Call `scroll-up-command', loading more toots if necessary.
-If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'."
- (interactive)
- (if (not (eq (point) (point-max)))
- (scroll-up-command)
- (mastodon-tl--more)
- (scroll-up-command)))
-
-(defun mastodon-tl-next-tab-item (&optional previous)
- "Move to the next interesting item.
-This could be the next toot, link, or image; whichever comes first.
-Don't move if nothing to move to is found, i.e. near the end of the buffer.
-This also skips tab items in invisible text, i.e. hidden spoiler text.
-PREVIOUS means move to previous item."
- (interactive)
- (let (next-range
- (search-pos (point)))
- (while (and (setq next-range
- (mastodon-tl--find-next-or-previous-property-range
- 'mastodon-tab-stop search-pos previous))
- (get-text-property (car next-range) 'invisible)
- (setq search-pos (if previous
- (1- (car next-range))
- (1+ (cdr next-range)))))
- ;; do nothing, all the action is in the while condition
- )
- (if (null next-range)
- (user-error "Nothing else here")
- (goto-char (car next-range))
- (message "%s" (mastodon-tl--property 'help-echo :no-move)))))
-
-(defun mastodon-tl-previous-tab-item ()
- "Move to the previous interesting item.
-This could be the previous toot, link, or image; whichever comes
-first. Don't move if nothing else to move to is found, i.e. near
-the start of the buffer. This also skips tab items in invisible
-text, i.e. hidden spoiler text."
- (interactive)
- (mastodon-tl-next-tab-item :previous))
-
-(defun mastodon-tl--goto-item-pos (find-pos refresh &optional pos)
- "Search for item with function FIND-POS.
-If search returns nil, execute REFRESH function.
-Optionally start from POS."
- (let* ((npos ; toot/user items have byline:
- (funcall find-pos
- (or pos
- (if (save-excursion
- (when (not (= 1 (point)))
- (backward-char 1))
- (looking-at "\u2068"))
- (1- (point))
- (point)))
- ;; FIXME: we need to fix item-type?
- ;; 'item-type ; breaks nav to last item in a view?
- 'byline
- (current-buffer)))
- (max-lisp-eval-depth 4)) ;; clamp down on endless loops
- (if npos
- (if (not (get-text-property npos 'item-type)) ; generic
- ;; FIXME let's make refresh &optional and only call refresh/recur
- ;; if non-nil:
- (mastodon-tl--goto-item-pos find-pos refresh npos)
- (goto-char npos)
- ;; force display of help-echo on moving to a toot byline:
- (mastodon-tl--message-help-echo)
- (when (looking-at "\u2068")
- (forward-char 1)))
- (condition-case nil
- (funcall refresh)
- (error "No more items")))))
-
-(defun mastodon-tl-goto-next-item (&optional no-refresh)
- "Jump to next item.
-Load more items it no next item.
-NO-REFRESH means do no not try to load more items if no next item
-found."
- (interactive)
- (condition-case nil
- (mastodon-tl--goto-item-pos 'next-single-property-change
- (unless no-refresh 'mastodon-tl--more))
- (t (error "No more items"))))
-
-(defun mastodon-tl-goto-prev-item (&optional no-refresh)
- "Jump to previous item.
-Update if no previous items.
-NO-REFRESH means do no not try to load more items if no next item
-found."
- (interactive)
- (condition-case nil
- (mastodon-tl--goto-item-pos 'previous-single-property-change
- (unless no-refresh 'mastodon-tl-update))
- (t (error "No more items"))))
-
-(defun mastodon-tl--goto-first-item ()
- "Jump to first toot or item in buffer.
-Used on initializing a timeline or thread."
- (goto-char (point-min))
- (condition-case nil
- (mastodon-tl--goto-item-pos 'next-single-property-change
- 'next-line)
- (t (error "No item"))))
-
-\f
-;;; TIMELINES
-
-(defun mastodon-tl-get-federated-timeline (&optional prefix local max-id)
- "Open federated timeline.
-If LOCAL, get only local timeline.
-With a single PREFIX arg, hide-replies.
-With a double PREFIX arg, only show posts with media."
- (interactive "p")
- (let ((params
- `(("limit" . ,mastodon-tl--timeline-posts-count)
- ,@(when (eq prefix 16)
- '(("only_media" . "true")))
- ,@(when local
- '(("local" . "true")))
- ,@(when max-id
- `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))))
- (message "Loading federated timeline...")
- (mastodon-tl--init (if local "local" "federated")
- "timelines/public" 'mastodon-tl--timeline nil
- params
- (when (eq prefix 4) t))))
-
-(defun mastodon-tl-get-home-timeline (&optional arg max-id)
- "Open home timeline.
-With a single prefix ARG, hide replies.
-MAX-ID is a flag to add the max_id pagination parameter."
- (interactive "p")
- (let* ((params
- `(("limit" . ,mastodon-tl--timeline-posts-count)
- ,@(when max-id
- `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))))
- (message "Loading home timeline...")
- (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil
- params
- (when (eq arg 4) t))))
-
-(defun mastodon-tl-get-remote-local-timeline (&optional endpoint)
- "Prompt for an instance domain and try to display its local timeline.
-You can enter any working instance domain. Domains that you want
-to regularly load can be stored in
-`mastodon-tl--remote-local-domains' for easy access with completion.
-Note that some instances do not make their local timelines public, in
-which case this will not work.
-To interact with any item, you must view it from your own
-instance, which you can do with
-`mastodon-tl-view-item-on-own-instance'.
-Optionally, provide API ENDPOINT."
- (interactive)
- (let* ((domain (completing-read "Domain for remote local tl: "
- mastodon-tl--remote-local-domains))
- (params `(("limit" . ,mastodon-tl--timeline-posts-count)
- ("local" . "true")))
- (buf (concat "remote-local-" domain))
- (known (member domain
- (mastodon-http--get-json
- (mastodon-http--api "instance/peers")))))
- ;; condition-case doesn't work here, so i added basic error handling to
- ;; `mastodon-tl--init*' instead
- (when (or known
- (y-or-n-p
- "Domain appears unknown to your instance. Proceed?"))
- (mastodon-tl--init buf
- (or endpoint "timelines/public")
- 'mastodon-tl--timeline nil
- params nil domain))))
-
-(defun mastodon-tl-remote-tag-timeline (&optional tag)
- "Call `mastodon-tl-get-remote-local-timeline' but for a TAG timeline."
- (interactive)
- (let* ((tag (or tag (read-string "Tag: ")))
- (endpoint (format "timelines/tag/%s" tag)))
- (mastodon-tl-get-remote-local-timeline endpoint)))
-
-(defun mastodon-tl-view-item-on-own-instance ()
- "Load current toot on your own instance.
-Use this to re-load remote-local items in order to interact with them."
- (interactive)
- (mastodon-tl--do-if-item
- (let* ((toot (mastodon-tl--property 'item-json))
- (uri (mastodon-tl--field 'uri toot)))
- (mastodon-url-lookup uri))))
-
-(defun mastodon-tl-get-local-timeline (&optional prefix max-id)
- "Open local timeline.
-With a single PREFIX arg, hide-replies.
-With a double PREFIX arg, only show posts with media.
-MAX-ID is a flag to add the max_id pagination parameter."
- (interactive "p")
- (message "Loading local timeline...")
- (mastodon-tl-get-federated-timeline prefix :local max-id))
-
-(defun mastodon-tl-get-tag-timeline (&optional prefix tag)
- "Prompt for tag and opens its timeline.
-Optionally load TAG timeline directly.
-With a single PREFIX arg, only show posts with media.
-With a double PREFIX arg, limit results to your own instance."
- (interactive "p")
- (let* ((word (or (word-at-point) ""))
- (input (or tag (read-string
- (format "Load timeline for tag (%s): " word))))
- (tag (or tag (if (string-empty-p input) word input))))
- (message "Loading timeline for #%s..." tag)
- (mastodon-tl--show-tag-timeline prefix tag)))
-
-(defun mastodon-tl--show-tag-timeline (&optional prefix tag)
- "Opens a new buffer showing the timeline of posts with hastag TAG.
-If TAG is a list, show a timeline for all tags.
-With a single PREFIX arg, only show posts with media.
-With a double PREFIX arg, limit results to your own instance."
- (let ((params
- `(("limit" . ,mastodon-tl--timeline-posts-count)
- ,@(when (eq prefix 4)
- '(("only_media" . "true")))
- ,@(when (eq prefix 16)
- '(("local" . "true"))))))
- (when (listp tag)
- (let ((list (mastodon-http--build-array-params-alist "any[]" (cdr tag))))
- (while list
- (push (pop list) params))))
- (mastodon-tl--init
- (if (listp tag) "tags-multiple" (concat "tag-" tag))
- (concat "timelines/tag/" (if (listp tag) (car tag) tag)) ; must be /tag/:sth
- 'mastodon-tl--timeline nil params)))
-
-(defun mastodon-tl--link-timeline (url)
- "Load a link timeline, displaying posts containing URL."
- (let ((params `(("url" . ,url))))
- (mastodon-tl--init "links" "timelines/link"
- 'mastodon-tl--timeline nil
- params)))
-
-(defun mastodon-tl-announcements ()
- "Display announcements from your instance."
- (interactive)
- (mastodon-tl--init "announcements" "announcements"
- 'mastodon-tl--timeline nil nil nil nil :no-byline))
-
-\f
-;;; BYLINES, etc.
-
-(defun mastodon-tl--message-help-echo ()
- "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
- (mastodon-tl--property 'item-json :no-move)))
- (echo (mastodon-tl--property 'help-echo :no-move)))
- (when (not (string= "" echo)) ; not for followers/following in profile
- (unless (or (string= type "follow_request")
- (string= type "follow")) ; no counts for these
- (message "%s" echo)))))
-
-(defun mastodon-tl--unicode-wrap (str)
- "Wrap STR in unicode directional isolates."
- ;; see https://unicode.org/reports/tr9/#Explicit_Directional_Isolates
- ;; via Tusky (again! thanks)
- ;; https://codeberg.org/tusky/Tusky/src/commit/16cef3d6202648e4fd67f06ef0fb1d0a2d04b68f/app/src/main/java/com/keylesspalace/tusky/util/StringUtils.kt#L65
- (concat "\u2068" str "\u2069"))
-
-(defun mastodon-tl--byline-username (toot)
- "Format a byline username from account in TOOT.
-TOOT may be account data, or toot data, in which case acount data
-is extracted from it."
- (let ((data (or (alist-get 'account toot)
- toot))) ;; grouped nofifs use account data directly
- (let-alist data
- (let ((disp (if (and .display_name
- (not (string-empty-p .display_name)))
- (mastodon-tl--unicode-wrap .display_name)
- .username)))
- (propertize disp
- 'face 'mastodon-display-name-face
- ;; enable playing of videos when point is on byline:
- ;; 'attachments (mastodon-tl--get-attachments-for-byline toot)
- 'keymap mastodon-tl--byline-link-keymap
- ;; echo faves count when point on post author name:
- ;; which is where --goto-next-toot puts point.
- 'help-echo
- ;; 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--format-byline-help-echo data)))))))
-
-(defun mastodon-tl--byline-handle (toot &optional domain string face)
- "Format a byline handle from account in TOOT.
-DOMAIN is optionally added to the handle.
-ACCOUNT is optionally acccount data to use.
-STRING is optionally the string to propertize, it is used to make
-username rather than handle buttons.
-FACE is optionally the face to use.
-The last two args allow for display a username as a clickable
-handle."
- (let-alist (or (alist-get 'account toot)
- toot) ;; grouped notifs
- (let ((str (or string
- (concat "@" .acct
- (when domain
- (concat "@"
- (url-host
- (url-generic-parse-url .url))))))))
- (mastodon-tl--buttonify-link
- (mastodon-tl--unicode-wrap str)
- 'face (or face 'mastodon-handle-face)
- 'mastodon-tab-stop 'user-handle
- 'shr-url .url
- 'mastodon-handle (concat "@" .acct)
- 'help-echo (concat "Browse user profile of @" .acct)))))
-
-(defun mastodon-tl--byline-uname-+-handle (data &optional domain)
- "Concatenate a byline username and handle.
-DATA is the (toot) data to use.
-DOMAIN is optionally a domain for the handle.
-ACCOUNT is optionally acccount data to use."
- (concat (mastodon-tl--byline-username data)
- " (" (mastodon-tl--byline-handle data domain) ")"))
-
-(defun mastodon-tl--display-or-uname (account)
- "Return display name or username from ACCOUNT data."
- (if (not (string-empty-p (alist-get 'display_name account)))
- (alist-get 'display_name account)
- (alist-get 'username account)))
-
-(defun mastodon-tl--byline-author (toot &optional avatar domain base)
- "Propertize author of TOOT.
-With arg AVATAR, include the account's avatar image.
-When DOMAIN, force inclusion of user's domain in their handle.
-BASE means to use data from the base item (reblog slot) if possible.
-If BASE is nil, we are a boosted byline, so show less info.
-ACCOUNT is optionally acccount data to use."
- (let* ((data (if base
- (mastodon-tl--toot-or-base toot)
- toot))
- (account (alist-get 'account data))
- (uname (mastodon-tl--display-or-uname account)))
- (concat
- ;; avatar insertion moved up to `mastodon-tl--byline' by default to
- ;; be outside 'byline propt.
- (when (and avatar ; used by `mastodon-profile--format-user'
- mastodon-tl--show-avatars
- mastodon-tl--display-media-p
- (mastodon-tl--image-trans-check))
- (mastodon-media--get-avatar-rendering
- (map-nested-elt data '(account avatar))))
- (if (not base)
- ;; boost symbol:
- (concat (mastodon-tl--symbol 'boost)
- " "
- ;; username as button:
- (mastodon-tl--byline-handle
- data domain
- ;; display uname not handle (for boosts):
- uname 'mastodon-display-name-face))
- ;; normal combo author byline:
- (mastodon-tl--byline-uname-+-handle data domain)))))
-
-(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-item' 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:
- (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
- (fol-req-p (let ((type (alist-get 'type toot-to-count)))
- (or (string= type "follow")
- (string= type "follow_request")))))
- (unless fol-req-p
- (let* ((media-types (mastodon-tl--get-media-types toot))
- (format-media (when media-types
- (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))
- " | C-RET to view with mpv")))
- (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)))
- (mastodon-tl--map-alist 'type attachments)))
-
-(defun mastodon-tl--get-attachments-for-byline (toot)
- "Return a list of attachment URLs and types for TOOT.
-The result is added as an attachments property to author-byline."
- (let ((media (mastodon-tl--field 'media_attachments toot)))
- (mapcar (lambda (attachment)
- (let-alist attachment
- (list :id .id
- :type .type
- ;; fallback for notifications:
- :url (or .remote_url .url))))
- media)))
-
-(defun mastodon-tl--acc-by-id (id)
- "Return account JSON for ID."
- (let* ((endpoint (format "accounts/%s" id))
- (url (mastodon-http--api endpoint)))
- (mastodon-http--get-json url)))
-
-(defun mastodon-tl--top-byline (toot)
- "Format a boost or reply top (action) byline for TOOT.
-If it is a self-reply, return 'continued thread'.
-If it is a non-self-reply, return 'in reply to $username'.
-If it is a boost, return '$username boosted'."
- (let ((reblog (alist-get 'reblog toot))
- (reply-acc-id (alist-get 'in_reply_to_account_id toot)))
- (cond
- (reblog
- (concat (mastodon-tl--byline-author toot) " "
- (propertize "boosted" 'face 'mastodon-boosted-face) "\n"))
- (reply-acc-id
- (unless (mastodon-tl--buffer-type-eq 'thread)
- (if (equal reply-acc-id (map-nested-elt toot '(account id)))
- (concat (mastodon-tl--symbol 'reply) " "
- (mastodon-tl--buttonify-link
- "continued thread\n"
- 'face 'mastodon-boosted-face
- 'continued-thread t
- 'help-echo "Browse thread"))
- (let* ((acc (mastodon-tl--acc-by-id reply-acc-id))
- (name (or (alist-get 'display_name acc)
- (alist-get 'username acc))))
- (concat (mastodon-tl--symbol 'reply)
- (mastodon-tl--buttonify-link
- " in reply to "
- 'face 'mastodon-boosted-face
- 'continued-thread t
- 'help-echo "Browse thread")
- (propertize name
- 'face 'mastodon-display-name-face)
- "\n")))))
- (t ""))))
-
-(defun mastodon-tl-continued-thread-load ()
- "Load thread based on prop item-id.
-Used to load self-reply threads by clicking on top-byline's \"continued
-thead\" text."
- (interactive)
- (let ((id (mastodon-tl--property 'item-id)))
- (mastodon-tl--thread-do id)))
-
-(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 ((string= letter "F")
- "favourited")
- ((string= letter "B")
- "boosted")
- ((string= 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--image-trans-check ()
- "Call `image-transforms-p', or `image-type-available-p' imagemagick."
- (if (version< emacs-version "27.1")
- (image-type-available-p 'imagemagick)
- (image-transforms-p)))
-
-(defun mastodon-tl--byline (toot &optional detailed-p
- domain base-toot group ts)
- "Generate (bottom) byline for TOOT.
-AUTHOR-BYLINE is a function for adding the author portion of
-the byline that takes one variable.
-DETAILED-P means display more detailed info. For now
-this just means displaying toot client.
-When DOMAIN, force inclusion of user's domain in their handle.
-BASE-TOOT is JSON for the base toot, if any.
-GROUP is the notification group if any.
-ACCOUNT is the notification account if any.
-TS is a timestamp from the server, if any."
- (let* ((type (alist-get 'type (or group toot)))
- (created-time
- (or ts ;; mentions, statuses, folls/foll-reqs
- ;; bosts, faves, edits, polls in notifs view use base item
- ;; timestamp:
- (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 (when created-time (date-to-time created-time)))
- ;; non-grouped notifs now need to pull the following data from
- ;; base toot:
- (base-maybe (or base-toot ;; show edits for notifs
- (mastodon-tl--toot-or-base toot))) ;; for boosts
- (faved (eq t (mastodon-tl--field 'favourited base-maybe)))
- (boosted (eq t (mastodon-tl--field 'reblogged base-maybe)))
- (bookmarked (eq t (mastodon-tl--field 'bookmarked base-maybe)))
- (visibility (mastodon-tl--field 'visibility base-maybe))
- (account (alist-get 'account base-maybe))
- (avatar-url (alist-get 'avatar account))
- (edited-time (alist-get 'edited_at base-maybe))
- (edited-parsed (when edited-time (date-to-time edited-time))))
- (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
- ;; ensures that `mastodon-tl-goto-next-item' puts point on
- ;; author-byline, not before the (F) or (B) marker. Not propertizing like
- ;; 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
- (mastodon-tl--symbol 'boost)))
- (when faved
- (mastodon-tl--format-faved-or-boosted-byline
- (mastodon-tl--symbol 'favourite)))
- (when bookmarked
- (mastodon-tl--format-faved-or-boosted-byline
- (mastodon-tl--symbol 'bookmark))))
- ;; we remove avatars from the byline also, so that they also do not
- ;; mess with `mastodon-tl-goto-next-item':
- (when (and mastodon-tl--show-avatars
- mastodon-tl--display-media-p
- (mastodon-tl--image-trans-check))
- (mastodon-media--get-avatar-rendering avatar-url))
- (propertize
- (concat
- ;; NB: action-byline (boost) is now added in insert-status, so no
- ;; longer part of the byline.
- ;; (base) author byline:
- ;; we use base-toot if poss for fave/boost notifs that need to show
- ;; base item in author byline
- (mastodon-tl--byline-author (or base-toot toot)
- nil domain :base)
- ;; visibility:
- (cond ((string= visibility "direct")
- (propertize (concat " " (mastodon-tl--symbol 'direct))
- 'help-echo visibility))
- ((string= visibility "private")
- (propertize (concat " " (mastodon-tl--symbol 'private))
- 'help-echo visibility)))
- " "
- ;; timestamp:
- (let ((ts (format-time-string
- mastodon-toot-timestamp-format parsed-time)))
- (propertize ts
- 'timestamp parsed-time
- 'display
- (if mastodon-tl--enable-relative-timestamps
- (mastodon-tl--relative-time-description parsed-time)
- parsed-time)
- 'help-echo ts))
- ;; detailed:
- (when detailed-p
- (let* ((app-name (map-nested-elt toot '(application name)))
- (app-url (map-nested-elt toot '(application website))))
- (when app-name
- (concat
- (propertize " via " 'face 'default)
- (propertize app-name
- 'face 'mastodon-display-name-face
- 'follow-link t
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'shr-url
- 'shr-url app-url
- 'help-echo app-url
- 'keymap mastodon-tl--shr-map-replacement)))))
- ;; edited:
- (when edited-time
- (concat
- " "
- (mastodon-tl--symbol 'edited)
- " "
- (propertize
- (format-time-string mastodon-toot-timestamp-format
- edited-parsed)
- 'face 'mastodon-toot-docs-face
- 'timestamp edited-parsed
- 'display (if mastodon-tl--enable-relative-timestamps
- (mastodon-tl--relative-time-description edited-parsed)
- edited-parsed))))
- (propertize (concat "\n " mastodon-tl--horiz-bar)
- 'face 'default)
- ;; stats:
- (when (and mastodon-tl--show-stats
- (not (member type '("follow" "follow_request"))))
- (mastodon-tl--toot-stats toot))
- "\n")
- 'favourited-p faved
- 'boosted-p boosted
- 'bookmarked-p bookmarked
- ;; enable playing of videos when point is on byline:
- 'attachments (mastodon-tl--get-attachments-for-byline toot)
- 'edited edited-time
- 'edit-history (when edited-time
- (mastodon-toot--get-toot-edits
- (alist-get 'id base-maybe)))
- 'byline t))))
-
-\f
-;;; TIMESTAMPS
-
-(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* ((time-difference (time-subtract current-time timestamp))
- (seconds-difference (float-time time-difference))
- (tmp (mastodon-tl--human-duration (max 0 seconds-difference))))
- ;; revert to old just now style for < 1 min
- (cons (concat (car tmp) (if (string= "just now" (car tmp)) "" " ago"))
- (time-add current-time (cdr tmp)))))
-
-(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)))
-
-\f
-;;; RENDERING HTML, LINKS, HASHTAGS, HANDLES
-
-(defun mastodon-tl--render-text (string &optional toot)
- "Return a propertized text rendering the given HTML string STRING.
-The contents comes from the given TOOT which is used in parsing
-links in the text. If TOOT is nil no parsing occurs."
- (when string ; handle rare empty notif server bug
- (with-temp-buffer
- (insert string)
- (let ((shr-use-fonts mastodon-tl--enable-proportional-fonts)
- (shr-width (when mastodon-tl--enable-proportional-fonts
- (if mastodon-tl--no-fill-on-render
- 0
- (- (window-width) 3))))
- (cat (get 'mastodon-tl-link 'button-category-symbol)))
- (shr-render-region (point-min) (point-max))
- (alter-text-property
- (point-min) (point-max) 'category
- (lambda (type) (when type cat))))
- ;; Make all links a tab stop recognized by our own logic, make
- ;; things point to our own logic (e.g. hashtags), and update keymaps
- ;; where needed:
- (when toot
- (let (region)
- (while (setq region (mastodon-tl--find-property-range
- 'shr-url (or (cdr region) (point-min))))
- (mastodon-tl--process-link toot
- (car region) (cdr region)
- (get-text-property (car region) 'shr-url))
- (when (proper-list-p toot) ;; not on profile fields cons cells
- ;; render card author maybe:
- (let* ((card-url (map-nested-elt toot '(card url)))
- (authors (map-nested-elt toot '(card authors)))
- (url (buffer-substring (car region) (cdr region)))
- (url-no-query (car (split-string url "?"))))
- (when (and (string= url-no-query card-url)
- ;; only if we have an account's data:
- (alist-get 'account (car authors)))
- (goto-char (point-max))
- (mastodon-tl--insert-card-authors authors)))))))
- (buffer-string))))
-
-(defun mastodon-tl--insert-card-authors (authors)
- "Insert a string of card AUTHORS."
- (let ((authors-str (format "Author%s: "
- (if (< 1 (length authors)) "s" ""))))
- (insert
- (concat
- "\n(" authors-str
- (mapconcat #'mastodon-tl--format-card-author authors "\n")
- ")\n"))))
-
-(defun mastodon-tl--format-card-author (data)
- "Render card author DATA."
- (when-let* ((account (alist-get 'account data))) ;.account
- (let-alist account ;.account
- ;; FIXME: replace with refactored handle render fun
- ;; in byline refactor branch:
- (concat
- (propertize (mastodon-tl--unicode-wrap (or .display_name .username))
- 'face 'mastodon-display-name-face
- 'item-type 'user
- 'item-id .id)
- " "
- (propertize (concat "@" .acct)
- 'face 'mastodon-handle-face
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'user-handle
- 'keymap mastodon-tl--link-keymap
- 'mastodon-handle (concat "@" .acct)
- 'help-echo (concat "Browse user profile of @" .acct))))))
-
-(defun mastodon-tl--process-link (toot start end url)
- "Process link URL in TOOT as hashtag, userhandle, or normal link.
-START and END are the boundaries of the link in the toot."
- (let* (mastodon-tab-stop-type
- keymap
- (help-echo (get-text-property start 'help-echo))
- extra-properties
- ;; handle calling this on non-toots, e.g. for profiles:
- (toot-url (when (proper-list-p toot)
- (mastodon-tl--field 'url toot)))
- (toot-url (when toot-url (url-generic-parse-url toot-url)))
- (toot-instance-url (if toot-url
- (concat (url-type toot-url) "://"
- (url-host toot-url))
- mastodon-instance-url))
- (link-str (buffer-substring-no-properties start end))
- (maybe-hashtag (mastodon-tl--hashtag-from-url
- url toot-instance-url))
- (maybe-userhandle
- (if (proper-list-p toot) ; fails for profile buffers?
- (or (mastodon-tl--userhandle-from-mentions toot link-str)
- (mastodon-tl--userhandle-from-url url link-str))
- (mastodon-tl--userhandle-from-url url link-str))))
- (cond (maybe-hashtag
- (setq mastodon-tab-stop-type 'hashtag
- keymap mastodon-tl--link-keymap
- help-echo (concat "Browse tag #" maybe-hashtag)
- extra-properties (list 'mastodon-tag maybe-hashtag)))
- (maybe-userhandle ;; fails on mentions in profile notes:
- (let ((maybe-userid (when (proper-list-p toot)
- (mastodon-tl--extract-userid-toot
- toot link-str))))
- (setq mastodon-tab-stop-type 'user-handle
- keymap mastodon-tl--link-keymap
- help-echo (concat "Browse user profile of " maybe-userhandle)
- extra-properties (append
- (list 'mastodon-handle maybe-userhandle)
- (when maybe-userid
- (list 'account-id maybe-userid))))))
- (t ;; Anything else (leave it as a url handled by shr.el):
- (setq keymap (if (eq shr-map (get-text-property start 'keymap))
- mastodon-tl--shr-map-replacement
- mastodon-tl--shr-image-map-replacement)
- mastodon-tab-stop-type 'shr-url)))
- (add-text-properties start end
- (append
- (list 'mastodon-tab-stop mastodon-tab-stop-type
- 'keymap keymap
- 'help-echo help-echo)
- extra-properties))))
-
-(defun mastodon-tl--userhandle-from-mentions (toot link)
- "Extract a user handle from mentions in json TOOT.
-LINK is maybe the `@handle' to search for."
- (mastodon-tl--el-from-mentions 'acct toot link))
-
-(defun mastodon-tl--extract-userid-toot (toot link)
- "Extract a user id for an ACCT from mentions in a TOOT.
-LINK is maybe the `@handle' to search for."
- (mastodon-tl--el-from-mentions 'id toot link))
-
-(defun mastodon-tl--el-from-mentions (el toot link)
- "Extract element EL from TOOT mentions that matches LINK.
-LINK should be a simple handle string with no domain, i.e. \"@user\".
-Return nil if no matching element."
- (let ((mentions (alist-get 'mentions toot)))
- (when mentions
- (let* ((mention (pop mentions))
- (name (substring-no-properties link 1 (length link))) ; cull @
- return)
- (while mention
- (when (string= name (alist-get 'username mention))
- (setq return (alist-get el mention)))
- (setq mention (pop mentions)))
- return))))
-
-(defun mastodon-tl--userhandle-from-url (url &optional buffer-text)
- "Return the user hande the URL points to or nil if it is not a profile link.
-BUFFER-TEXT is the text covered by the link with URL, for a user profile
-this should be of the form <at-sign><user id>, e.g. \"@Gargon\".
-This is called on all post URLs, so needs to handle non profile URLs
-gracefully."
- (let* ((parsed-url (url-generic-parse-url url))
- (host (url-host parsed-url))
- (local-p (string=
- (url-host (url-generic-parse-url mastodon-instance-url))
- host))
- (path-raw (url-filename parsed-url)))
- (unless (string-empty-p path-raw)
- (let ((path (substring path-raw 1))) ;; remove "/" prefix
- (if (not buffer-text)
- (when (string-prefix-p "@" path)
- (if local-p path (concat "@" host)))
- (when (and (string= "@" (substring buffer-text 0 1))
- ;; don't error on domain only url (rare):
- (string= (downcase buffer-text)
- (downcase path)))
- (if local-p
- buffer-text ; no instance suffix for local mention
- (concat buffer-text "@" host))))))))
-
-(defun mastodon-tl--hashtag-from-url (url instance-url)
- "Return the hashtag that URL points to or nil if URL is not a tag link.
-INSTANCE-URL is the url of the instance for the toot that the link
-came from (tag links always point to a page on the instance publishing
-the toot)."
- ;; TODO: do we rly need to check it against instance-url?
- ;; test suggests we might
- (let* ((instance-host (url-host
- (url-generic-parse-url instance-url)))
- (parsed (url-generic-parse-url url))
- (path (url-filename parsed)))
- (when (string= instance-host (url-host parsed))
- (cond ((string-prefix-p "/tag" path) ;; "/tag/" or "/tags/"
- (let ((split (split-string path "/")))
- (nth 2 split)))
- ((string-prefix-p "?t=" path) ;; snac tag
- (let ((split (split-string path "=")))
- (nth 1 split)))))))
-
-(defun mastodon-tl--base-tags (tags body-tags)
- "Return a string of all tags not in BODY-TAGS, linkified.
-TAGS is a list of tag alists, from a post's JSON."
- (when (mastodon-tl--base-tags-print-p tags body-tags)
- (concat
- "\n"
- (cl-loop for tag in tags
- concat (concat (mastodon-tl--render-base-tag tag body-tags)
- " ")))))
-
-(defun mastodon-tl--base-tags-print-p (tags body-tags)
- "Non-nil if we need to print base tags.
-We need to do so if TAGS contains any elements not in BODY-TAGS."
- (cl-remove-if
- (lambda (tag)
- ;; downcase name string (body strings are downcased):
- (member (downcase (alist-get 'name tag)) body-tags))
- tags))
-
-(defun mastodon-tl--render-base-tag (tag body-tags)
- "Return TAG as a linkified string, provided it is not in BODY-TAGS."
- (let ((name (alist-get 'name tag)))
- (unless (member (downcase name) body-tags)
- (mastodon-tl--buttonify-link
- (concat "#" name)
- 'mastodon-tab-stop 'hashtag
- 'mastodon-tag name
- 'mouse-face '(highlight)
- 'keymap mastodon-tl--link-keymap
- 'face '(shr-text shr-link)
- 'follow-link t
- 'shr-tab-stop t
- 'shr-url (alist-get 'url tag)
- 'help-echo (concat "Browse tag #" name)))))
-
-\f
-;;; HYPERLINKS
-
-(define-button-type 'mastodon-tl-link
- 'action #'mastodon-tl--push-button
- 'keymap mastodon-tl--link-keymap
- 'mouse-face 'highlight)
-
-(defun mastodon-tl--push-button (button)
- "Do the appropriate action for BUTTON."
- (mastodon-tl-do-link-action-at-point (button-start button)))
-
-(defun mastodon-tl--buttonify-link (string &rest properties)
- "Make STRING a `mastodon-tl-link' type button.
-PROPERTIES are additional properties to attach to string."
- (apply #'propertize string
- 'button t
- 'category (get 'mastodon-tl-link 'button-category-symbol)
- properties))
-
-(defun mastodon-tl--make-link (string link-type)
- "Return a propertized version of STRING that will act like link.
-LINK-TYPE is the type of link to produce."
- (let ((help-text (cond ((eq link-type 'content-warning)
- "Toggle hidden text")
- ((or (eq link-type 'read-more)
- (eq link-type 'read-less))
- "Toggle full post")
- (t
- (error "Unknown link type %s" link-type)))))
- (mastodon-tl--buttonify-link string
- 'mastodon-tab-stop link-type
- 'help-echo help-text)))
-
-(defun mastodon-tl-do-link-action-at-point (pos)
- "Do the action of the link at POS.
-Used for hitting RET on a given link."
- (interactive "d")
- (let ((link-type (get-text-property pos 'mastodon-tab-stop))
- (cont-thread (mastodon-tl--property 'continued-thread :nomove)))
- (cond (cont-thread
- (mastodon-tl-continued-thread-load))
- ((eq link-type 'content-warning)
- (mastodon-tl--toggle-spoiler-text pos))
- ((eq link-type 'hashtag)
- (mastodon-tl--show-tag-timeline
- nil (get-text-property pos 'mastodon-tag)))
- ;; 'account / 'account-id is not set for mentions, only bylines
- ((eq link-type 'user-handle)
- (let ((account-json (get-text-property pos 'account))
- (account-id (get-text-property pos 'account-id)))
- (cond
- (account-json
- (mastodon-profile--make-author-buffer account-json))
- (account-id
- (mastodon-profile--make-author-buffer
- (mastodon-profile--account-from-id account-id)))
- (t
- (let ((account (mastodon-profile--search-account-by-handle
- (get-text-property pos 'mastodon-handle))))
- ;; never call make-author-buffer on nil account:
- (cond (account
- (mastodon-profile--make-author-buffer account))
- ;; optional webfinger lookup:
- ((y-or-n-p
- "Search for account returned nothing. Perform URL lookup?")
- (mastodon-url-lookup (get-text-property pos 'shr-url)))
- (t
- (error "Unable to find account"))))))))
- ((eq link-type 'shr-url)
- (mastodon-url-lookup (get-text-property pos 'shr-url)))
- ((eq link-type 'read-more)
- (mastodon-tl-unfold-post))
- ((eq link-type 'read-less)
- (mastodon-tl-fold-post))
- (t
- (error "Unknown link type %s" link-type)))))
-
-(defun mastodon-tl-do-link-action (event)
- "Do the action of the link at point.
-Used for a mouse-click EVENT on a link."
- (interactive "@e")
- (mastodon-tl-do-link-action-at-point (posn-point (event-end event))))
-
-\f
-;;; 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
-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-region (mastodon-tl--find-property-range
- 'mastodon-content-warning-body position nil))
- (new-state (not (get-text-property (car spoiler-region)
- 'invisible))))
- (if (not spoiler-region)
- (user-error "No spoiler text here")
- (add-text-properties (car spoiler-region) (cdr spoiler-region)
- (list 'invisible new-state))
- new-state))) ;; return what we set invisibility to
-
-(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
- 'item-json (point))
- (mastodon-tl--find-property-range
- 'item-json (point) t)))
- (spoiler-range (when toot-range
- (mastodon-tl--find-property-range
- 'mastodon-content-warning-body
- (car toot-range)))))
- (cond ((null toot-range)
- (user-error "No toot here"))
- ((or (null spoiler-range)
- (> (car spoiler-range) (cdr toot-range)))
- (user-error "No content warning text here"))
- (t
- (mastodon-tl--toggle-spoiler-text (car spoiler-range))))))
-
-(defun mastodon-tl-toggle-spoiler-in-thread ()
- "Toggler content warning for all posts in current thread."
- (interactive)
- (let ((thread-p (eq (mastodon-tl--buffer-property 'update-function)
- 'mastodon-tl--thread-do)))
- (if (not thread-p)
- (user-error "Not in a thread")
- (save-excursion
- (goto-char (point-min))
- (while (not (string= "No more items" ; improve this hack test!
- (mastodon-tl-goto-next-item :no-refresh)))
- (let* ((json (mastodon-tl--property 'item-json :no-move))
- (cw (alist-get 'spoiler_text json)))
- (when (not (string= "" cw))
- (let ((new-state
- (pcase
- (mastodon-tl-toggle-spoiler-text-in-toot)
- ('t 'folded)
- ('nil 'unfolded))))
- (plist-put mastodon-tl--buffer-spec
- 'thread-unfolded new-state)))))))))
-
-(defun mastodon-tl--spoiler (toot &optional filter)
- "Render TOOT with spoiler message.
-This assumes TOOT is a toot with a spoiler message.
-The main body gets hidden and only the spoiler text and the
-content warning message are displayed. The content warning
-message is a link which unhides/hides the main body.
-FILTER is a string to use as a filter warning spoiler instead."
- (let* ((spoiler (mastodon-tl--field 'spoiler_text toot))
- (string (mastodon-tl--set-face
- (mastodon-tl--clean-tabs-and-nl
- (mastodon-tl--render-text spoiler toot))
- 'default))
- (message (concat " " mastodon-tl--horiz-bar "\n "
- (mastodon-tl--make-link
- (if filter
- (concat "Filtered: " filter)
- (concat "CW: " string))
- 'content-warning)
- "\n "
- mastodon-tl--horiz-bar "\n"))
- (cw (mastodon-tl--set-face message 'mastodon-cw-face)))
- (concat
- cw
- (propertize
- (mastodon-tl--content toot)
- 'invisible
- (or filter ;; filters = invis
- (let ((cust mastodon-tl--expand-content-warnings))
- (if (not (eq 'server cust))
- (not cust) ;; opp to setting
- ;; respect server setting:
- ;; If something goes wrong reading prefs,
- ;; just return t so CWs fold by default.
- (condition-case nil
- (if (eq :json-false
- (mastodon-profile--get-preferences-pref
- 'reading:expand:spoilers))
- t
- nil)
- (error t)))))
- 'mastodon-content-warning-body t))))
-
-\f
-;;; MEDIA
-
-(defun mastodon-tl--media (toot)
- "Retrieve a media attachment link for TOOT if one exists.
-Else return an empty string."
- (let* ((attachments (mastodon-tl--field 'media_attachments toot))
- (sensitive (mastodon-tl--field 'sensitive toot))
- (media-string (mapconcat
- (lambda (x)
- (mastodon-tl--media-attachment x sensitive))
- attachments "")))
- (if (not (and mastodon-tl--display-media-p
- (string-empty-p media-string)))
- (concat "\n" media-string)
- "")))
-
-(defun mastodon-tl--media-attachment (attachment sensitive)
- "Return a propertized string for ATTACHMENT.
-SENSITIVE is a flag from the item's JSON data."
- (let-alist attachment
- (let ((display-str
- (concat "Media:: "
- (if (and mastodon-tl--display-caption-not-url-when-no-media
- .description)
- .description
- .preview_url)))
- (remote-url (or .remote_url .url)))
- (if (and mastodon-tl--display-media-p
- ;; if in notifs, also check notifs images custom:
- (if (or (mastodon-tl--buffer-type-eq 'notifications)
- (mastodon-tl--buffer-type-eq 'mentions))
- mastodon-images-in-notifs
- t))
- (mastodon-media--get-media-link-rendering ; placeholder: "[img]"
- .preview_url remote-url ; for shr-browse-url
- .type .description sensitive)
- ;; return URL/caption:
- (concat (mastodon-tl--propertize-img-str-or-url
- (concat "Media:: " .preview_url) ; string
- .preview_url remote-url .type .description
- display-str 'shr-link .description sensitive)
- "\n")))))
-
-(defun mastodon-tl--propertize-img-str-or-url
- (str media-url full-remote-url type help-echo
- &optional display face caption sensitive)
- "Propertize an media placeholder string \"[img]\" or media URL.
-STR is the string to propertize, MEDIA-URL is the preview link,
-FULL-REMOTE-URL is the link to the full resolution image on the
-server, TYPE is the media type.
-HELP-ECHO, DISPLAY, and FACE are the text properties to add.
-CAPTION is the image caption, added as a text property.
-SENSITIVE is a flag from the item's JSON data."
- (propertize str
- 'media-url media-url
- 'media-state (when (string= str "[img]") 'needs-loading)
- 'media-type 'media-link
- 'mastodon-media-type type
- 'display display
- 'face face
- 'mouse-face 'highlight
- 'mastodon-tab-stop 'image ; for do-link-action-at-point
- 'image-url (or full-remote-url media-url) ; for shr-browse-image
- 'keymap mastodon-tl--shr-image-map-replacement
- 'image-description caption
- 'sensitive sensitive
- '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"))))
-
-;;; FULL IMAGE VIEW
-
-(define-derived-mode mastodon-image-mode image-mode
- "mastodon-image"
- :group 'mastodon
- ;; Disable `pixel-scroll-precision-mode' locally because it doesn't
- ;; work nicely with `mastodon-image-mode':
- ;; thanks Tusar for this fix:
- (when (bound-and-true-p pixel-scroll-precision-mode)
- (setq-local pixel-scroll-precision-mode nil)))
-
-;; patch `shr-browse-image' to accept url arg:
-(defun mastodon-tl-shr-browse-image (&optional arg)
- "Browse the image under point.
-With a prefix argument, copy the URL of the image instead.
-If URL is a string, use it rather than the image-url property at point."
- (interactive "P")
- (let ((prop (get-text-property (point) 'image-url)))
- (if current-prefix-arg
- (if (not prop)
- (user-error "No image at point?")
- (with-temp-buffer
- (insert prop)
- (copy-region-as-kill (point-min) (point-max))
- (message "Copied %s" prop)))
- (let ((url (or arg prop)))
- (if (not url)
- (user-error "No URL here?")
- (message "Browsing %s..." url)
- (browse-url url))))))
-
-(defun mastodon-tl--view-image-url (url attachments)
- "View image URL. Set ATTACHMENTS metadata in image buffer."
- (if (not url)
- (user-error "No url found")
- (if (not mastodon-tl--load-full-sized-images-in-emacs)
- (mastodon-tl-shr-browse-image url)
- (mastodon-media--image-or-cached
- url #'mastodon-media--process-full-sized-image-response
- `(nil ,url ,attachments ,(buffer-name))))))
-
-(defun mastodon-tl-view-full-image-at-point ()
- "Browse full-sized version of image at point in a new window."
- (interactive)
- (if (not (eq (mastodon-tl--property 'mastodon-tab-stop) 'image))
- (user-error "No image at point?")
- (let* ((url (mastodon-tl--property 'image-url))
- (attachments (mastodon-tl--property 'attachments)))
- (mastodon-tl--view-image-url url attachments))))
-
-(defun mastodon-tl-view-first-full-image ()
- "From item byline, fetch load its first full image."
- (interactive)
- (let* ((attachments (mastodon-tl--property 'attachments))
- (url (plist-get (car attachments) :url)))
- (if (not attachments)
- (user-error "Toot has no attachments")
- (mastodon-tl--view-image-url url attachments))))
-
-(defun mastodon-tl--get-next-image-url ()
- "Return the url for the next image to load.
-Cycles through values in `mastodon-media--attachments'."
- (let* ((url (car mastodon-media--attachments))
- ;; match url against our plists:
- (current (mastodon-tl--current-image-url url)))
- ;; fetch from next item in current or use first item if current has
- ;; only 1 item:
- (plist-get (if (= 1 (length current))
- (cadr mastodon-media--attachments)
- (cadr current))
- :url)))
-
-(defun mastodon-tl--current-image-url (url)
- "Try to fetch URL from `mastodon-media--attachments'.
-The return value is that of `cl-member-if', ie if a match is found, it
-returns the match and the list of which it is the car."
- (cl-member-if
- (lambda (attachment)
- (equal url (plist-get attachment :url)))
- (cdr mastodon-media--attachments)))
-
-(defun mastodon-tl--get-prev-image-url ()
- "Return the URL of the previous item in `mastodon-media--attachments'."
- (let* ((url (car mastodon-media--attachments))
- (current (mastodon-tl--current-image-url url)))
- (plist-get (nth (1- (length current))
- (cdr mastodon-media--attachments))
- :url)))
-
-(defun mastodon-tl-next-full-image ()
- "From full image view buffer, load the toot's next image."
- (interactive)
- (let* ((next-url (mastodon-tl--get-next-image-url)))
- (mastodon-tl--view-image-url next-url
- (cdr mastodon-media--attachments))))
-
-(defun mastodon-tl-prev-full-image ()
- "From full image view buffer, load the toot's prev image."
- (interactive)
- (let* ((prev-url (mastodon-tl--get-prev-image-url)))
- (mastodon-tl--view-image-url prev-url
- (cdr mastodon-media--attachments))))
-
-(defun mastodon-tl-toggle-sensitive-image ()
- "Toggle dislay of sensitive image at point."
- (interactive)
- (if (not (eq t (mastodon-tl--property 'sensitive)))
- (user-error "No sensitive media at point?")
- (let ((data (mastodon-tl--property 'image-data :no-move))
- (inhibit-read-only t)
- (end (next-single-property-change (point) 'sensitive-state)))
- (add-text-properties
- (point) end
- (if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move))
- ;; display:
- `( display ,data
- sensitive-state showing)
- ;; hide:
- `( sensitive-state hidden
- display
- ,(create-image
- mastodon-media--sensitive-image-data nil t)))))))
-
-\f
-;; POLLS
-
-(defun mastodon-tl--format-poll-option (option counter length)
- "Format poll OPTION. COUNTER is a counter.
-LENGTH is of the longest option, for formatting."
- (format "%s: %s%s%s\n"
- counter
- (propertize (alist-get 'title option)
- 'face 'success)
- (make-string (1+ (- length
- (length (alist-get 'title option))))
- ?\ )
- ;; TODO: disambiguate no votes from hidden votes
- (format "[%s votes]" (or (alist-get 'votes_count option)
- "0"))))
-
-(defun mastodon-tl--format-poll (poll)
- "From json poll data POLL, return a display string."
- (let-alist poll
- (let* ((options (mastodon-tl--map-alist 'title .options))
- (longest (car (sort (mapcar #'length options ) #'>)))
- (counter 0))
- (concat "\n"
- (mastodon-tl--symbol 'poll)
- "\n\n"
- (mapconcat (lambda (option)
- (setq counter (1+ counter))
- (mastodon-tl--format-poll-option
- option counter longest))
- .options
- "\n")
- "\n"
- (propertize
- (cond (.voters_count ; sometimes it is nil
- (format "%s %s | " .voters_count
- (if (= .voters_count 1) "person" "people")))
- (.vote_count
- (format "%s votes | " .vote_count))
- (t ""))
- 'face 'mastodon-toot-docs-face)
- (let ((str (if (eq .expired :json-false)
- (if (eq .expires_at nil)
- ""
- (mastodon-tl--format-poll-expiry .expires_at))
- "Poll expired.")))
- (propertize str 'face 'mastodon-toot-docs-face))
- "\n"))))
-
-(defconst mastodon-tl--time-units
- '("sec" 60.0 ;; Use a float to convert `n' to float.
- "min" 60
- "hour" 24
- "day" 7
- "week" 4.345
- "month" 12
- "year"))
-
-(defun mastodon-tl--format-poll-expiry (timestamp)
- "Convert poll expiry TIMESTAMP into a descriptive string.
-TIMESTAMP is from the expires_at field of a poll's JSON data, and
-is in ISO 8601 Datetime format."
- (let* ((ts (encode-time (parse-time-string timestamp)))
- (seconds (time-to-seconds (time-subtract ts nil))))
- ;; FIXME: Use the `cdr' to update poll expiry times?
- (concat (car (mastodon-tl--human-duration (max 0 seconds))) " left")))
-
-(defun mastodon-tl--human-duration (seconds &optional resolution)
- "Return a string describing SECONDS in a more human-friendly way.
-The return format is (STRING . RES) where RES is the resolution of
-this string, in seconds.
-RESOLUTION is the finest resolution, in seconds, to use for the
-second part of the output (defaults to 60, so that seconds are only
-displayed when the duration is smaller than a minute)."
- (cl-assert (>= seconds 0))
- (unless resolution (setq resolution 60))
- (let* ((units mastodon-tl--time-units)
- (n1 seconds) (unit1 (pop units)) (res1 1)
- n2 unit2 res2
- next)
- (while (and units (> (truncate (setq next (/ n1 (car units)))) 0))
- (setq unit2 unit1)
- (setq res2 res1)
- (setq n2 (- n1 (* (car units) (truncate n1 (car units)))))
- (setq n1 next)
- (setq res1 (truncate (* res1 (car units))))
- (pop units)
- (setq unit1 (pop units)))
- (setq n1 (truncate n1))
- (if n2 (setq n2 (truncate n2)))
- (cond
- ((null n2)
- ;; revert to old just now style for < 1 min:
- (cons "just now" 60))
- ;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
- ;; (max resolution res1)))
- ((< (* res2 n2) resolution)
- (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
- (max resolution res2)))
- ((< res2 resolution)
- (let ((n2 (/ (* resolution (/ (* n2 res2) resolution)) res2)))
- (cons (format "%d %s%s, %d %s%s"
- n1 unit1 (if (> n1 1) "s" "")
- n2 unit2 (if (> n2 1) "s" ""))
- resolution)))
- (t
- (cons (format "%d %s%s, %d %s%s"
- n1 unit1 (if (> n1 1) "s" "")
- n2 unit2 (if (> n2 1) "s" ""))
- (max res2 resolution))))))
-
-(defun mastodon-tl--format-read-poll-option (options)
- "Format poll OPTIONS for `completing-read'.
-OPTIONS is an alist."
- ;; we display option number and the option title
- ;; but also store both as a cons cell as the cdr, as we need it later
- (cl-loop for cell in options
- collect (cons (format "%s | %s" (car cell) (cdr cell))
- cell)))
-
-(defun mastodon-tl--read-poll-option ()
- "Read a poll option to vote on a poll."
- (let* ((toot (mastodon-tl--property 'item-json))
- (poll (mastodon-tl--field 'poll toot)))
- (if (null poll)
- (user-error "No poll here")
- (let* ((options (mastodon-tl--field 'options poll))
- (titles (mastodon-tl--map-alist 'title options))
- (number-seq (number-sequence 1 (length options)))
- (numbers (mapcar #'number-to-string number-seq))
- (options-alist (cl-mapcar #'cons numbers titles))
- (candidates (mastodon-tl--format-read-poll-option options-alist))
- (choice (completing-read "Poll option to vote for: "
- candidates nil :match)))
- (list (cdr (assoc choice candidates)))))))
-
-(defun mastodon-tl-poll-vote (option)
- "If there is a poll at point, prompt user for OPTION to vote on it."
- (interactive (mastodon-tl--read-poll-option))
- (let ((toot (mastodon-tl--property 'item-json)))
- (if (null (mastodon-tl--field 'poll toot))
- (user-error "No poll here")
- (let* ((poll (mastodon-tl--field 'poll toot))
- (id (alist-get 'id poll))
- (url (mastodon-http--api (format "polls/%s/votes" id)))
- ;; zero-index our option:
- (option-arg (number-to-string
- (1- (string-to-number (car option)))))
- (arg `(("choices[]" . ,option-arg)))
- (response (mastodon-http--post url arg)))
- (mastodon-http--triage response
- (lambda (_)
- (message "You voted for option %s: %s!"
- (car option) (cdr option))))))))
-
-\f
-;; 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))
- vids)
- (cl-loop for x in attachments
- do (let ((att-type (plist-get x :type)))
- (when (or (string= "video" att-type)
- (string= "gifv" att-type))
- (push x vids))))
- (car vids)))
-
-(defun mastodon-tl-mpv-play-video-from-byline ()
- "Run `mastodon-tl-mpv-play-video-at-point' on first moving image in post."
- (interactive)
- (let* ((video (mastodon-tl--find-first-video-in-attachments))
- (url (plist-get video :url))
- (type (plist-get video :type)))
- (mastodon-tl-mpv-play-video-at-point url type)))
-
-(defun mastodon-tl-view-full-image-or-play-video (_pos)
- "View full sized version of image at point, or try to play video."
- (interactive "d")
- (if (mastodon-tl--media-video-p)
- (mastodon-tl-mpv-play-video-at-point)
- (mastodon-tl-view-full-image-at-point)))
-
-(defun mastodon-tl-click-image-or-video (event)
- "Click to play video with `mpv.el'.
-EVENT is a mouse-click arg."
- (interactive "@e")
- (mastodon-tl-view-full-image-or-play-video
- (posn-point (event-end event))))
-
-(defun mastodon-tl--media-video-p (&optional type)
- "T if mastodon-media-type prop is \"gifv\" or \"video\".
-TYPE is a mastodon media type."
- (let ((type (or type (mastodon-tl--property 'mastodon-media-type :no-move))))
- (or (string= type "gifv")
- (string= type "video"))))
-
-(defun mastodon-tl-mpv-play-video-at-point (&optional url type)
- "Play the video or gif at point with an mpv process.
-URL and TYPE are provided when called while point is on byline,
-in which case play first video or gif from current toot."
- (interactive)
- (let ((url (or url ; point in byline:
- (mastodon-tl--property 'image-url :no-move)))) ; point in toot
- (if (or (not url)
- (not (mastodon-tl--media-video-p type)))
- (user-error "No moving image here?")
- (message "'q' to kill mpv.")
- (condition-case x
- (mpv-start "--loop" url)
- (void-function
- (message "Looks like mpv.el not installed. Error: %s"
- (error-message-string x)))))))
-
-(defun mastodon-tl-copy-image-caption ()
- "Copy the caption of the image at point."
- (interactive)
- (if-let* ((desc (get-text-property (point) 'image-description)))
- (progn
- (kill-new desc)
- (message "Image caption copied."))
- (message "No image caption.")))
-
-\f
-;;; INSERT TOOTS
-
-(defun mastodon-tl--content (toot)
- "Retrieve text content from TOOT.
-Runs `mastodon-tl--render-text' and fetches poll or media."
- (let* ((content (mastodon-tl--field 'content toot))
- (poll-p (mastodon-tl--field 'poll toot))
- (media-p (mastodon-tl--field 'media_attachments toot)))
- (concat (mastodon-tl--render-text content toot)
- (when poll-p
- (mastodon-tl--format-poll
- (mastodon-tl--field 'poll toot))) ;; toot or reblog
- (when media-p
- (mastodon-tl--media toot)))))
-
-(defun mastodon-tl--prev-item-id ()
- "Return the id of the last toot inserted into the buffer."
- (let* ((prev-change
- (save-excursion
- (previous-single-property-change (point) 'base-item-id)))
- (prev-pos (when prev-change (1- prev-change))))
- (when prev-pos
- (get-text-property prev-pos 'base-item-id))))
-
-(defun mastodon-tl--after-reply-status (reply-to-id)
- "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer."
- (let ((prev-id (mastodon-tl--prev-item-id)))
- (string= reply-to-id prev-id)))
-
-(defun mastodon-tl--body-tags (body)
- "Return a plain string list of the tags in BODY."
- ;; NB: replies on text props 'mastodon-tab-stop and 'shr-url
- ;; FIXME: snac tags fail our prop test, not sure about others.
- (let (list prop)
- (with-temp-buffer
- (insert body)
- (goto-char (point-min))
- (save-match-data
- (while
- (setq prop (text-property-search-forward
- 'mastodon-tab-stop 'hashtag t))
- (goto-char (prop-match-beginning prop))
- (let ((tag (mastodon-tl--property 'mastodon-tag)))
- (when tag
- (push (downcase tag) list)))
- (goto-char (prop-match-end prop)))))
- list))
-
-(defun mastodon-tl--insert-quoted (data)
- "Propertize quoted status DATA for insertion."
- (let ((bar (concat " " (mastodon-tl--symbol 'reply-bar)))
- (content (map-nested-elt data '(quoted_status content)))
- ;; quote symbol hack:
- (quotemark (propertize "“" 'face
- '(t :inherit success :weight bold
- :height 1.8))))
- (propertize
- (concat quotemark "\n"
- ;; author byline without horiz bar and toot stats:
- (mastodon-tl--byline-author
- (alist-get 'quoted_status data) nil :domain :base)
- "\n"
- ;; quoted text:
- (mastodon-tl--render-text content
- (alist-get 'quoted_status data)))
- 'line-prefix bar
- 'wrap-prefix bar
- 'mastodon-quote data)))
-
-(defun mastodon-tl--insert-status
- (toot body &optional detailed-p thread domain unfolded no-byline
- cw-expanded)
- "Display the content and byline of timeline element TOOT.
-BODY will form the section of the toot above the byline.
-DETAILED-P means display more detailed info. For now
-this just means displaying toot client.
-THREAD means the status will be displayed in a thread view.
-When DOMAIN, force inclusion of user's domain in their handle.
-UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
-NO-BYLINE means just insert toot body, used for folding.
-CW-EXPANDED means treat content warnings as unfolded."
- (let* ((reply-to-id (alist-get 'in_reply_to_id toot))
- (after-reply-status-p
- (when (and thread reply-to-id)
- (mastodon-tl--after-reply-status reply-to-id)))
- ;; (type (alist-get 'type toot))
- (toot-foldable
- (and mastodon-tl--fold-toots-at-length
- (length> body mastodon-tl--fold-toots-at-length)))
- (cw-p (not
- (string-empty-p
- (alist-get 'spoiler_text toot))))
- (body-tags (mastodon-tl--body-tags body))
- (quote (mastodon-tl--field 'quote toot)))
- (insert
- (propertize ;; body + byline:
- (concat
- (propertize ;; body only:
- (concat
- "\n"
- (mastodon-tl--top-byline toot) ;; (boost, in reply to)
- ;; relpy symbol:
- (when (and after-reply-status-p thread)
- (concat (mastodon-tl--symbol 'replied)
- "\n"))
- ;; actual body:
- (let ((bar (mastodon-tl--symbol 'reply-bar))
- (body (if (and toot-foldable (not unfolded))
- (mastodon-tl--fold-body body)
- body)))
- (concat
- (if (and after-reply-status-p thread)
- (propertize body
- 'line-prefix bar
- 'wrap-prefix bar)
- body)
- ;; insert quote maybe:
- (when quote
- (concat "\n\n"
- (mastodon-tl--insert-quoted quote)
- ))))
- (if (and toot-foldable unfolded cw-expanded)
- (mastodon-tl--read-more-or-less
- "LESS" cw-p (not cw-expanded))
- ""))
- 'toot-body t) ;; includes newlines etc. for folding
- ;; post tags:
- (let ((tags (alist-get 'tags toot)))
- ;; FIXME: we also need to test here for normal body tags, and if
- ;; so, don't go ahead:
- (if tags (concat (mastodon-tl--base-tags tags body-tags)) ""))
- ;; byline:
- "\n"
- (if no-byline
- ""
- (mastodon-tl--byline toot detailed-p domain)))
- 'item-type 'toot
- 'item-id (alist-get 'id toot) ; toot id
- 'base-item-id (mastodon-tl--item-id toot) ; with reblog check
- 'item-json toot
- 'cursor-face 'mastodon-cursor-highlight-face
- 'toot-foldable toot-foldable
- 'toot-folded (and toot-foldable (not unfolded)))
- (if no-byline "" "\n"))))
-
-(defun mastodon-tl--is-reply (toot)
- "Check if the TOOT is a reply to another one (and not boosted).
-Used as a predicate in `mastodon-tl--timeline'."
- (and (mastodon-tl--field 'in_reply_to_id toot)
- (eq :json-false (mastodon-tl--field 'reblogged toot))))
-
-(defun mastodon-tl--filters-alist (filters)
- "Parse filter data for FILTERS.
-For each filter, return a list of action (warn or hide), filter
-title, and context."
- (cl-loop for x in filters ;; includes non filter elts!
- for f = (alist-get 'filter x)
- collect (list (alist-get 'filter_action f)
- (alist-get 'title f)
- (alist-get 'context f))))
-
-(defun mastodon-tl--filter-by-context (context filters)
- "Remove FILTERS that don't apply to the current CONTEXT."
- (cl-remove-if-not
- (lambda (x)
- (member context (nth 2 x)))
- filters))
-
-(defun mastodon-tl--filters-context ()
- "Return a string of the current buffer's filter context.
-Returns a member of `mastodon-views--filter-types'."
- (let ((buf (mastodon-tl--get-buffer-type)))
- (cond ((or (eq buf 'local) (eq buf 'federated))
- "public")
- ((mastodon-tl--profile-buffer-p)
- "profile")
- ((eq buf 'list-timeline)
- "home") ;; lists are "home" filter
- (t ;; thread, notifs, home:
- (symbol-name buf)))))
-
-(defun mastodon-tl--current-filters (filters)
- "Return the filters from FILTERS data that apply in the current context.
-For each filter, return a list of action (warn or hide), filter
-title, and context."
- (let ((context (mastodon-tl--filters-context))
- (filters-no-context (mastodon-tl--filters-alist filters)))
- (mastodon-tl--filter-by-context context filters-no-context)))
-
-(defun mastodon-tl--toot (toot &optional detailed-p thread domain
- unfolded no-byline cw-expanded)
- "Format TOOT and insert it into the buffer.
-DETAILED-P means display more detailed info. For now
-this just means displaying toot client.
-THREAD means the status will be displayed in a thread view.
-When DOMAIN, force inclusion of user's domain in their handle.
-UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
-NO-BYLINE means just insert toot body, used for folding.
-CW-EXPANDED means treat content warnings as unfolded."
- (let* ((mastodon-tl--expand-content-warnings
- (or cw-expanded mastodon-tl--expand-content-warnings))
- (filtered (mastodon-tl--field 'filtered toot))
- (filters (when filtered
- (mastodon-tl--current-filters filtered)))
- (spoiler-or-content (if-let* ((match (assoc "warn" filters)))
- (mastodon-tl--spoiler toot (cadr match))
- (if (mastodon-tl--has-spoiler toot)
- (mastodon-tl--spoiler toot)
- (mastodon-tl--content toot)))))
- ;; If any filters are "hide", then we hide,
- ;; even though item may also have a "warn" filter:
- (unless (and filtered (assoc "hide" filters)) ;; no insert
- (mastodon-tl--insert-status
- toot (mastodon-tl--clean-tabs-and-nl spoiler-or-content)
- detailed-p thread domain unfolded no-byline cw-expanded))))
-
-(defun mastodon-tl--timeline (toots &optional thread domain no-byline)
- "Display each toot in TOOTS.
-This function removes replies if user required.
-THREAD means the status will be displayed in a thread view.
-When DOMAIN, force inclusion of user's domain in their handle.
-NO-BYLINE means just insert toot body, used for folding."
- (let ((start-pos (point))
- (toots ;; hack to *not* filter replies on profiles:
- (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses)
- toots
- (if (or ; we were called via --more*:
- (mastodon-tl--buffer-property 'hide-replies nil :no-error)
- ;; loading a tl with a prefix arg:
- (mastodon-tl--hide-replies-p current-prefix-arg))
- (cl-remove-if-not #'mastodon-tl--is-reply toots)
- toots))))
- (cl-loop for toot in toots
- do (mastodon-tl--toot toot nil thread domain nil no-byline))
- ;; media:
- (when mastodon-tl--display-media-p
- (mastodon-media--inline-images start-pos (point)))
- (goto-char (point-min))))
-
-;;; FOLDING
-
-(defun mastodon-tl--read-more-or-less (str cw invis)
- "Return a read more or read less heading.
-STR is an uppercase string, either MORE or LESS.
-The heading is a link to toggle the fold status of the toot.
-CW and INVIS are boolean values for the properties invisible and
-mastodon-content-warning-body."
- (let ((type (if (string= str "MORE") 'read-more 'read-less)))
- (propertize
- (mastodon-search--format-heading
- (mastodon-tl--make-link (format "READ %s" str) type)
- nil :no-newline)
- 'mastodon-content-warning-body cw
- 'invisible invis)))
-
-(defun mastodon-tl--fold-body (body)
- "Fold toot BODY if it is very long.
-Folding decided by `mastodon-tl--fold-toots-at-length'."
- (let* ((invis (get-text-property (1- (length body)) 'invisible body))
- (cw (get-text-property (1- (length body))
- 'mastodon-content-warning-body body))
- (heading (mastodon-tl--read-more-or-less "MORE" cw invis))
- (display (concat (substring body 0
- mastodon-tl--fold-toots-at-length)
- heading)))
- (propertize display
- 'read-more body)))
-
-(defun mastodon-tl-unfold-post (&optional fold)
- "Unfold the toot at point if it is folded (read-more).
-FOLD means to fold it instead."
- (interactive)
- (let ((at-byline (mastodon-tl--property 'byline :no-move)))
- (if (save-excursion
- (when (not at-byline)
- (mastodon-tl-goto-next-item))
- (not (mastodon-tl--property 'toot-foldable :no-move)))
- (user-error "No foldable item at point?")
- (let* ((inhibit-read-only t)
- (body-range (mastodon-tl--find-property-range 'toot-body
- (point) :backward))
- (cw-range (mastodon-tl--find-property-range
- 'mastodon-content-warning-body
- (point) :backward))
- (cw-invis (when cw-range
- (get-text-property (car cw-range) 'invisible)))
- (toot (mastodon-tl--property 'item-json :no-move))
- ;; `replace-region-contents' is much too slow, our hack from
- ;; fedi.el is much simpler and much faster:
- (beg (car body-range))
- (end (cdr body-range))
- (last-point (point))
- (point-after-fold (> last-point
- (+ beg mastodon-tl--fold-toots-at-length))))
- ;; save-excursion here useless actually:
- ;; FIXME: because point goes to top of item, the screen gets scrolled
- ;; by insertion
- (goto-char beg)
- (delete-region beg end)
- (delete-char 1) ;; prevent newlines accumulating
- ;; insert toot body:
- (mastodon-tl--toot toot nil nil nil (not fold) :no-byline
- (unless cw-invis :cw-expanded)) ;; respect CW state
- ;; set toot-folded prop on entire toot (not just body):
- (let ((toot-range ;; post fold action range:
- (mastodon-tl--find-property-range 'item-json
- (point) :backward)))
- (add-text-properties (car toot-range)
- (cdr toot-range)
- `(toot-folded ,fold)))
- ;; try to leave point somewhere sane:
- (cond ((or at-byline
- (and fold point-after-fold)) ;; point was in area now folded
- (ignore-errors (forward-line -1)) ;; in case we are between
- (mastodon-tl-goto-next-item)) ;; goto byline
- (t
- (goto-char last-point)
- (when point-after-fold ;; point was in READ MORE heading:
- (beginning-of-line))))
- (message (format "%s toot" (if fold "Fold" "Unfold")))))))
-
-(defun mastodon-tl-fold-post ()
- "Fold post at point, if it is too long."
- (interactive)
- (mastodon-tl-unfold-post :fold))
-
-(defun mastodon-tl-fold-post-toggle ()
- "Toggle the folding status of the toot at point."
- (interactive)
- (let* ((folded (mastodon-tl--property 'toot-folded :no-move)))
- (mastodon-tl-unfold-post (not folded))))
-
-;;; TOOT STATS
-
-;; calqued off 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) 'item-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'."
- (let-alist (mastodon-tl--toot-for-stats toot)
- (let* ((faves-prop (propertize (format "%s" .favourites_count)
- 'favourites-count .favourites_count))
- (boosts-prop (propertize (format "%s" .reblogs_count)
- 'boosts-count .reblogs_count))
- (faves (format "%s %s" faves-prop (mastodon-tl--symbol 'favourite)))
- (boosts (format "%s %s" boosts-prop (mastodon-tl--symbol 'boost)))
- (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply)))
- (stats (concat
- (propertize faves
- 'favourited-p (eq t .favourited)
- 'favourites-field t
- 'help-echo (format "%s favourites" .favourites_count)
- 'face 'mastodon-toot-docs-face)
- (propertize " | " 'face 'mastodon-toot-docs-face)
- (propertize boosts
- 'boosted-p (eq t .reblogged)
- 'boosts-field t
- 'help-echo (format "%s boosts" .reblogs_count)
- 'face 'mastodon-toot-docs-face)
- (propertize " | " 'face 'mastodon-toot-docs-face)
- (propertize replies
- 'replies-field t
- 'replies-count .replies_count
- 'help-echo (format "%s replies" .replies_count)
- 'face 'mastodon-toot-docs-face)))
- (right-spacing
- (propertize " "
- 'display
- `(space :align-to (- right ,(+ (length stats) 7))))))
- (concat right-spacing stats))))
-
-\f
-;;; BUFFER SPEC
-
-(defun mastodon-tl--update-function (&optional buffer)
- "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'.
-Optionally get it for BUFFER."
- (mastodon-tl--buffer-property 'update-function buffer))
-
-(defun mastodon-tl--endpoint (&optional buffer no-error)
- "Get the ENDPOINT stored in `mastodon-tl--buffer-spec'.
-Optionally set it for BUFFER.
-NO-ERROR means to fail silently."
- (mastodon-tl--buffer-property 'endpoint buffer no-error))
-
-(defun mastodon-tl--buffer-name (&optional buffer no-error)
- "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'.
-Optionally get it for BUFFER.
-NO-ERROR means to fail silently."
- (mastodon-tl--buffer-property 'buffer-name buffer no-error))
-
-(defun mastodon-tl--link-header (&optional buffer)
- "Get the LINK HEADER stored in `mastodon-tl--buffer-spec'.
-Optionally get it for BUFFER."
- (mastodon-tl--buffer-property 'link-header buffer :no-error))
-
-(defun mastodon-tl--update-params (&optional buffer)
- "Get the UPDATE PARAMS stored in `mastodon-tl--buffer-spec'.
-Optionally get it for BUFFER."
- (mastodon-tl--buffer-property 'update-params buffer :no-error))
-
-(defun mastodon-tl--buffer-property (property &optional buffer no-error)
- "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'.
-If NO-ERROR is non-nil, do not error when property is empty."
- (with-current-buffer (or buffer (current-buffer))
- (if no-error
- (plist-get mastodon-tl--buffer-spec property)
- (or (plist-get mastodon-tl--buffer-spec property)
- (error "Mastodon-tl--buffer-spec not defined for buffer %s, prop %s"
- (or buffer (current-buffer))
- property)))))
-
-(defun mastodon-tl--set-buffer-spec
- (buffer endpoint update-fun
- &optional link-header update-params hide-replies max-id
- thread-item-id)
- "Set `mastodon-tl--buffer-spec' for the current buffer.
-BUFFER is buffer name, ENDPOINT is buffer's enpoint,
-UPDATE-FUN is its update function.
-LINK-HEADER is the http Link header if present.
-UPDATE-PARAMS is any http parameters needed for the update function.
-HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer.
-MAX-ID is the pagination parameter.
-THREAD-ITEM-ID is the ID of the item in thread that we opened the thread with."
- (setq mastodon-tl--buffer-spec
- `( account ,(cons mastodon-active-user mastodon-instance-url)
- buffer-name ,buffer
- endpoint ,endpoint
- update-function ,update-fun
- link-header ,link-header
- update-params ,update-params
- hide-replies ,hide-replies
- max-id ,max-id
- thread-item-id ,thread-item-id)))
-
-\f
-;;; BUFFERS
-
-(defun mastodon-tl--endpoint-str-= (str &optional type)
- "Return T if STR is equal to the current buffer's endpoint.
-TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix."
- (let ((endpoint-fun (mastodon-tl--endpoint nil :no-error)))
- (cond ((eq type :prefix)
- (string-prefix-p str endpoint-fun))
- ((eq type :suffix)
- (string-suffix-p str endpoint-fun))
- (t
- (string= str endpoint-fun)))))
-
-(defun mastodon-tl--get-buffer-type ()
- "Return a symbol descriptive of current mastodon buffer type.
-Should work in all mastodon buffers.
-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 ((buffer-name (mastodon-tl--buffer-name nil :no-error)))
- (cond (mastodon-toot-mode
- ;; composing/editing (no buffer spec):
- (if (string= "*edit toot*" (buffer-name))
- 'edit-toot
- 'new-toot))
- ;; main timelines:
- ((mastodon-tl--endpoint-str-= "timelines/home")
- 'home)
- ((string= "*mastodon-local*" buffer-name)
- 'local)
- ((mastodon-tl--endpoint-str-= "timelines/public")
- 'federated)
- ((mastodon-tl--endpoint-str-= "timelines/tag/" :prefix)
- 'tag-timeline)
- ((mastodon-tl--endpoint-str-= "timelines/list/" :prefix)
- 'list-timeline)
- ;; notifs:
- ((string-suffix-p "mentions*" buffer-name)
- 'mentions)
- ((mastodon-tl--endpoint-str-= "notifications")
- 'notifications)
- ((mastodon-tl--endpoint-str-= "notifications/requests")
- 'notification-requests)
- ;; threads:
- ((mastodon-tl--endpoint-str-= "context" :suffix)
- 'thread)
- ((mastodon-tl--endpoint-str-= "statuses" :prefix)
- 'single-status)
- ;; profiles:
- ((mastodon-tl--profile-buffer-p)
- (cond
- ;; an own profile option is needlessly confusing e.g. for
- ;; `mastodon-profile-account-view-cycle'
- ;; profile note:
- ((string-suffix-p "update-profile*" buffer-name)
- 'update-profile-note)
- ;; posts inc. boosts:
- ((string-suffix-p "no-boosts*" buffer-name)
- 'profile-statuses-no-boosts)
- ((string-suffix-p "no-replies*" buffer-name)
- 'profile-statuses-no-replies)
- ((string-suffix-p "only-media*" buffer-name)
- 'profile-statuses-only-media)
- ((string-match-p "-tagged-" buffer-name)
- 'profile-statuses-tagged)
- ((mastodon-tl--endpoint-str-= "statuses" :suffix)
- 'profile-statuses)
- ;; profile followers
- ((mastodon-tl--endpoint-str-= "followers" :suffix)
- 'profile-followers)
- ;; profile following
- ((mastodon-tl--endpoint-str-= "following" :suffix)
- 'profile-following)))
- ((mastodon-tl--endpoint-str-= "preferences")
- 'preferences)
- ;; search
- ((mastodon-tl--search-buffer-p)
- (cond ((string= "accounts" (mastodon-search--buf-type))
- 'search-accounts)
- ((string= "hashtags" (mastodon-search--buf-type))
- 'search-hashtags)
- ((string= "statuses" (mastodon-search--buf-type))
- 'search-statuses)))
- ;; trends
- ((mastodon-tl--endpoint-str-= "trends/statuses")
- 'trending-statuses)
- ((mastodon-tl--endpoint-str-= "trends/tags")
- 'trending-tags)
- ((mastodon-tl--endpoint-str-= "trends/links")
- 'trending-links)
- ;; User's views:
- ((mastodon-tl--endpoint-str-= "filters")
- 'filters)
- ((mastodon-tl--endpoint-str-= "lists")
- 'lists)
- ((mastodon-tl--endpoint-str-= "suggestions")
- 'follow-suggestions)
- ((mastodon-tl--endpoint-str-= "favourites")
- 'favourites)
- ((mastodon-tl--endpoint-str-= "bookmarks")
- 'bookmarks)
- ((mastodon-tl--endpoint-str-= "follow_requests")
- 'follow-requests)
- ((mastodon-tl--endpoint-str-= "scheduled_statuses")
- 'scheduled-statuses)
- ;; instance description
- ((mastodon-tl--endpoint-str-= "instance")
- 'instance-description)
- ((string= "*mastodon-toot-edits*" buffer-name)
- 'toot-edits)
- ((string= "*masto-image*" (buffer-name))
- 'mastodon-image)
- ((mastodon-tl--endpoint-str-= "timelines/link")
- 'link-timeline)
- ((mastodon-tl--endpoint-str-= "announcements")
- 'announcements)
- ;; followed hashtags
- ((mastodon-tl--endpoint-str-= "followed_tags")
- 'followed-hashtags))))
-
-(defun mastodon-tl--buffer-type-eq (type)
- "Return t if current buffer type is equal to symbol TYPE."
- (eq (mastodon-tl--get-buffer-type) type))
-
-(defun mastodon-tl--profile-buffer-p ()
- "Return t if current buffer is a profile buffer of any kind.
-This includes the update profile note buffer, but not the preferences one."
- (string-prefix-p "accounts" (mastodon-tl--endpoint nil :no-error)))
-
-(defun mastodon-tl--own-profile-buffer-p ()
- "Return t if we are viewing our own profile buffer.
-We check that our account credientials id matches the endpoint id in the
-buffer spec, which if in a profile buffer is of the form
-\"accounts/$id/statuses\"."
- (and (mastodon-tl--profile-buffer-p)
- (let ((endpoint-id
- (nth 1
- (split-string (mastodon-tl--endpoint) "/"))))
- (string= (mastodon-auth--get-account-id)
- endpoint-id))))
-
-(defun mastodon-tl--search-buffer-p ()
- "T if current buffer is a search buffer."
- (string-suffix-p "search" (mastodon-tl--endpoint nil :no-error)))
-
-(defun mastodon-tl--timeline-proper-p ()
- "Return non-nil if the current buffer is a \"proper\" timeline.
-A proper timeline excludes notifications, threads, profiles, and
-other toot buffers that aren't strictly mastodon timelines."
- (let ((timeline-buffers
- '(home federated local tag-timeline list-timeline profile-statuses)))
- (member (mastodon-tl--get-buffer-type) timeline-buffers)))
-
-(defun mastodon-tl--hide-replies-p (&optional prefix)
- "Return non-nil if replies should be hidden in the timeline.
-We hide replies if user explictly set the
-`mastodon-tl--hide-replies' or used PREFIX combination to open a
-timeline."
- (and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline
- (or (mastodon-tl--buffer-property 'hide-replies nil :noerror)
- mastodon-tl--hide-replies ; User configured to hide replies
- (equal '(4) prefix)))) ; Timeline called with C-u prefix
-
-\f
-;;; UTILITIES
-
-(defun mastodon-tl--clean-tabs-and-nl (string)
- "Remove tabs and newlines from STRING."
- (replace-regexp-in-string "[\t\n ]*\\'" "" string))
-
-(defun mastodon-tl--map-alist (key alists &optional testfn)
- "Return a list of values extracted from ALISTS with KEY.
-Key is a symbol, as with `alist-get', or else compatible with TESTFN.
-ALISTS is a list of alists."
- ;; this actually for a list of alists, right? so change the arg?
- (cl-loop for x in alists
- collect (alist-get key x nil nil testfn)))
-
-(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."
- (cl-loop for x in alist
- collect (cons (alist-get key1 x)
- (alist-get key2 x))))
-
-(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--field-status (field toot)
- "Return FIELD from TOOT.
-Return value from status field if available."
- (or (alist-get field (alist-get 'status 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 NO-MOVE is non-nil.
-BACKWARD means move backward (up) the timeline."
- (if no-move
- (get-text-property (point) prop)
- ;; NB: this doesn't differentiate absence of property from
- ;; property set to zero, making flag props fraught:
- (or (get-text-property (point) prop)
- (save-excursion
- (if backward
- (mastodon-tl-goto-prev-item)
- (mastodon-tl-goto-next-item))
- (get-text-property (point) prop)))))
-
-(defun mastodon-tl--newest-id ()
- "Return item-id from the top of the buffer.
-If we are in a notifications view, return `notifications-max-id'."
- (save-excursion
- (goto-char (point-min))
- (mastodon-tl--property
- (if (eq (mastodon-tl--get-buffer-type)
- (member (mastodon-tl--get-buffer-type)
- '(mentions notifications)))
- 'notifications-max-id
- 'item-id))))
-
-(defun mastodon-tl--oldest-id ()
- "Return item-id from the bottom of the buffer.
-If we are in a notifications view, return `notifications-min-id'."
- (save-excursion
- (goto-char (point-max))
- (mastodon-tl--property
- (if (and mastodon-group-notifications
- (member (mastodon-tl--get-buffer-type)
- '(mentions notifications)))
- 'notifications-min-id
- 'item-id)
- nil :backward)))
-
-(defun mastodon-tl--as-string (numeric)
- "Convert NUMERIC to string."
- (cond ((numberp numeric)
- (number-to-string numeric))
- ((stringp numeric) numeric)
- (t (error "Numeric: %s must be either a string or a number"
- numeric))))
-
-(defun mastodon-tl--item-id (json)
- "Find approproiate toot id in JSON.
-If the toot has been boosted use the id found in the
-reblog portion of the toot. Otherwise, use the body of
-the toot. This is the same behaviour as the mastodon.social
-webapp"
- (let-alist json
- (if .reblog .reblog.id .id)))
-
-(defun mastodon-tl--toot-or-base (json)
- "Return the base toot or just the toot from toot JSON."
- (or (alist-get 'reblog json) json))
-
-\f
-;;; THREADS
-
-(defun mastodon-tl-view-single-toot ()
- "View toot at point in a separate buffer."
- (interactive)
- (let ((id (mastodon-tl--property 'base-item-id)))
- (mastodon-tl--single-toot id)))
-
-(defun mastodon-tl--single-toot (id)
- "View toot in separate buffer.
-ID is that of the toot to view."
- (let* ((buffer (format "*mastodon-toot-%s*" id))
- (toot (mastodon-http--get-json
- (mastodon-http--api (concat "statuses/" id)))))
- (if (eq (caar toot) 'error)
- (user-error "Error: %s" (cdar toot))
- (with-mastodon-buffer buffer #'mastodon-mode nil
- (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id)
- #'mastodon-tl--update-toot
- ;; id for reload on reply:
- nil nil nil nil id)
- (mastodon-tl--toot toot :detailed-p)
- (goto-char (point-min))
- (when mastodon-tl--display-media-p
- (mastodon-media--inline-images (point-min)
- (point-max)))
- (mastodon-tl-goto-next-item :no-refresh)))))
-
-(defun mastodon-tl--update-toot (json)
- "Call `mastodon-tl-single-toot' on id found in JSON."
- (let ((id (alist-get 'id json)))
- (mastodon-tl--single-toot id)))
-
-(defun mastodon-tl-view-whole-thread ()
- "From a thread view, view entire thread.
-If you load a thread from a toot, only the branches containing
-are displayed by default. Call this if you subsequently want to
-view all branches of a thread."
- (interactive)
- (if (not (eq (mastodon-tl--get-buffer-type) 'thread))
- (user-error "You need to be viewing a thread to call this")
- (goto-char (point-min))
- (let ((id (mastodon-tl--property 'base-item-id)))
- (mastodon-tl--thread-do id))))
-
-(defun mastodon-tl-return ()
- "Load user profile or thread of item at point.
-If item at point is a follow or follow request, load user profile.
-Else load thread."
- (interactive)
- (let ((notif (mastodon-tl--property 'notification-type)))
- (if (or (equal "follow" notif)
- (equal "follow_request" notif))
- (let* ((json (mastodon-tl--property 'item-json))
- (handle (alist-get 'acct json)))
- (mastodon-profile-show-user handle))
- (mastodon-tl-thread))))
-
-(defun mastodon-tl-thread ()
- "Open thread buffer for toot at point."
- (interactive)
- (if (not (eq 'toot (mastodon-tl--property 'item-type :no-move)))
- (user-error "Looks like there's no toot at point?")
- (mastodon-tl--thread-do)))
-
-(defun mastodon-tl--thread-do (&optional thread-id)
- "Open thread buffer for toot at point or with THREAD-ID.
-This is the non-interactive version, so we can call it
-programmatically and not crash into
-`mastodon-toot--with-toot-item'."
- ;; this function's var must not be id as the above macro binds id and
- ;; even if we provide the arg (e.g. url-lookup), the macro definition
- ;; overrides it, making the optional arg unusable!
- (let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move)))
- (type
- (if (and (mastodon-tl--buffer-type-eq 'notifications)
- mastodon-group-notifications)
- (mastodon-tl--property 'notification-type)
- (mastodon-tl--field 'type
- (mastodon-tl--property 'item-json :no-move))))
- (unfolded-state (mastodon-tl--buffer-property 'thread-unfolded
- (current-buffer) :noerror))
- (mastodon-tl--expand-content-warnings
- ;; if reloading and thread was explicitly (un)folded, respect it:
- (or (pcase unfolded-state
- ('folded nil)
- ('unfolded t)
- (_ mastodon-tl--expand-content-warnings)))))
- (if (or (string= type "follow_request")
- (string= type "follow")) ; no can thread these
- (user-error "No thread")
- (let* ((endpoint (format "statuses/%s/context" id))
- (url (mastodon-http--api endpoint))
- (buffer (format "*mastodon-thread-%s*" id))
- (toot (mastodon-http--get-json ; refetch in case we just faved/boosted:
- (mastodon-http--api (concat "statuses/" id))
- nil :silent))
- (context (mastodon-http--get-json url nil :silent)))
- (if (eq (caar toot) 'error)
- (user-error "Error: %s" (cdar toot))
- (when (member (alist-get 'type toot) '("reblog" "favourite"))
- (setq toot (alist-get 'status toot)))
- (if (not (< 0 (+ (length (alist-get 'ancestors context))
- (length (alist-get 'descendants context)))))
- ;; just print the lone toot:
- (mastodon-tl--single-toot id)
- ;; we have a thread:
- (with-mastodon-buffer buffer #'mastodon-mode nil
- (let ((marker (make-marker)))
- (mastodon-tl--set-buffer-spec buffer endpoint
- #'mastodon-tl--thread-do
- nil nil nil nil id)
- (when unfolded-state
- (plist-put mastodon-tl--buffer-spec
- 'thread-unfolded unfolded-state))
- (when-let* ((ancestors (alist-get 'ancestors context)))
- (mastodon-tl--timeline ancestors :thread))
- (goto-char (point-max))
- (move-marker marker (point))
- ;; print re-fetched toot:
- (mastodon-tl--toot toot :detailed-p :thread)
- ;; inline images only for the toot
- ;; (`mastodon-tl--timeline' handles the rest):
- (when mastodon-tl--display-media-p
- (mastodon-media--inline-images marker ;start-pos
- (point)))
- (when-let* ((descendants (alist-get 'descendants context)))
- (mastodon-tl--timeline descendants :thread))
- ;; put point at the toot:
- (goto-char (marker-position marker))
- (mastodon-tl-goto-next-item :no-refresh)))))))))
-
-(defun mastodon-tl-mute-thread ()
- "Mute the thread displayed in the current buffer.
-Note that you can only (un)mute threads you have posted in."
- (interactive)
- (mastodon-tl--mute-or-unmute-thread))
-
-(defun mastodon-tl-unmute-thread ()
- "Unmute the thread displayed in the current buffer.
-Note that you can only (un)mute threads you have posted in."
- (interactive)
- (mastodon-tl--mute-or-unmute-thread :unmute))
-
-(defun mastodon-tl--thread-parent-id ()
- "Return the ID of the top item in a thread."
- (save-excursion
- (mastodon-tl--goto-first-item)
- (mastodon-tl--property 'base-item-id :no-move)))
-
-(defun mastodon-tl--mute-or-unmute-thread (&optional unmute)
- "Mute a thread.
-If UNMUTE, unmute it."
- (let ((mute-str (if unmute "unmute" "mute")))
- (when (or (mastodon-tl--buffer-type-eq 'thread)
- (mastodon-tl--buffer-type-eq 'notifications))
- (let* ((id
- ;; the id for `mastodon-tl--user-in-thread-p' ought to be the
- ;; top-level item:
- (if (mastodon-tl--buffer-type-eq 'notifications)
- (mastodon-tl--property 'base-item-id :no-move)
- (mastodon-tl--thread-parent-id)))
- (we-posted-p (mastodon-tl--user-in-thread-p id))
- (url (mastodon-http--api (format "statuses/%s/%s" id mute-str))))
- (if (not we-posted-p)
- (user-error "You can only (un)mute a thread you have posted in")
- (when (y-or-n-p (format "%s this thread? " mute-str))
- (let ((response (mastodon-http--post url)))
- (mastodon-http--triage
- response
- (lambda (_)
- (message (format "Thread %sd!" mute-str)))))))))))
-
-(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)
- (map-nested-elt status '(account id)))
- 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."
- (let* ((context-json (mastodon-http--get-json
- (mastodon-http--api (format "statuses/%s/context" id))
- nil :silent))
- (ancestors (alist-get 'ancestors context-json))
- (descendants (alist-get 'descendants context-json))
- (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))))
-
-\f
-;;; FOLLOW/BLOCK/MUTE, ETC
-
-(defun mastodon-tl-follow-user (user-handle
- &optional notify langs reblogs json)
- "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.
-LANGS is an array parameters alist of languages to filer user's posts by.
-REBLOGS is a boolean string like NOTIFY, enabling or disabling
-display of the user's boosts in your timeline.
-JSON is a flag arg for `mastodon-http--post'."
- (interactive (list (mastodon-tl--user-handles-get "follow")))
- (mastodon-tl--do-if-item
- (mastodon-tl--do-user-action-and-response
- user-handle "follow" nil notify langs reblogs json)))
-
-(defun mastodon-tl-follow-user-by-handle (user-handle)
- "Prompt for a USER-HANDLE and follow that user.
-USER-HANDLE can also be a URL to a user profile page."
- ;; code adapted from sachac:
- ;; https://sachachua.com/dotemacs/index.html#mastodon. thanks sachac!
- (interactive "MHandle: ")
- (when (string-match "https?://\\(.+?\\)/\\(@.+\\)" user-handle)
- (setq user-handle
- ;; sachac's model doesn't work with local user handles in URL,
- ;; meaning the search below will fail, so we use our own
- ;; URL-to-handle function, modified for the purpose:
- ;; (concat (match-string 2 user-handle) "@" (match-string 1 user-handle))))
- (mastodon-tl--userhandle-from-url user-handle)))
- (let* ((account (mastodon-profile--search-account-by-handle
- user-handle))
- (user-id (alist-get 'id account))
- (name (if (not (string-empty-p
- (alist-get 'display_name account)))
- (alist-get 'display_name account)
- (alist-get 'username account)))
- (url (mastodon-http--api (format "accounts/%s/%s" user-id "follow"))))
- (if account
- (mastodon-tl--do-user-action-function url name
- (substring user-handle 1) "follow")
- (user-error "Cannot find a user with handle %S" user-handle))))
-
-;; TODO: make this action "enable/disable notifications"
-(defun mastodon-tl-enable-notify-user-posts (user-handle)
- "Query for USER-HANDLE and enable notifications when they post."
- (interactive (list (mastodon-tl--user-handles-get "enable")))
- (mastodon-tl--do-if-item
- (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."
- (interactive (list (mastodon-tl--user-handles-get "disable")))
- (mastodon-tl-follow-user user-handle "false"))
-
-(defun mastodon-tl-follow-user-disable-boosts (user-handle)
- "Prompt for a USER-HANDLE, and disable display of boosts in home timeline.
-If they are also not yet followed, follow them."
- (interactive (list (mastodon-tl--user-handles-get "disable boosts")))
- (mastodon-tl-follow-user user-handle nil nil "false"))
-
-(defun mastodon-tl-follow-user-enable-boosts (user-handle)
- "Prompt for a USER-HANDLE, and enable display of boosts in home timeline.
-If they are also not yet followed, follow them.
-You only need to call this if you have previously disabled
-display of boosts."
- (interactive (list (mastodon-tl--user-handles-get "enable boosts")))
- (mastodon-tl-follow-user user-handle nil nil "true"))
-
-(defun mastodon-tl-filter-user-user-posts-by-language (user-handle)
- "Query for USER-HANDLE and filter display of their posts by language.
-If they are not already followed, they will be too.
-To be filtered, a post has to be marked as in the language given.
-This may mean that you will not see posts that are in your
-desired language if they are not marked as such (or as anything)."
- (interactive (list (mastodon-tl--user-handles-get "filter by language")))
- (let ((langs (mastodon-tl--read-filter-langs)))
- (mastodon-tl--do-if-item
- (if (string= "" (cdar langs))
- (mastodon-tl-unfilter-user-languages user-handle)
- (mastodon-tl-follow-user user-handle nil langs)))))
-
-(defun mastodon-tl-unfilter-user-languages (user-handle)
- "Remove any language filters for USER-HANDLE.
-This means you will receive posts of theirs marked as being in
-any or no language."
- (interactive (list (mastodon-tl--user-handles-get "filter by language")))
- (let ((langs "languages[]"))
- (mastodon-tl--do-if-item
- ;; we need "languages[]" as a param, with no "=" and not json-encoded as
- ;; a string
- (mastodon-tl-follow-user user-handle nil langs nil :raw))))
-
-(defun mastodon-tl--read-filter-langs (&optional langs)
- "Read language choices and return an alist array parameter.
-LANGS is the accumulated array param alist if we re-run recursively."
- (let* ((iso-const mastodon-iso-639-1)
- (iso (cons '("None (all)" . "") iso-const))
- (langs-alist langs)
- (choice (completing-read "Filter user's posts by language: "
- iso)))
- (when choice
- (setq langs-alist
- (push `("languages[]" . ,(alist-get choice iso
- nil nil #'string=))
- langs-alist))
- (if (y-or-n-p "Filter by another language? ")
- (mastodon-tl--read-filter-langs langs-alist)
- langs-alist))))
-
-(defun mastodon-tl-unfollow-user (user-handle)
- "Query for USER-HANDLE from current status and unfollow that user."
- (interactive (list (mastodon-tl--user-handles-get "unfollow")))
- (mastodon-tl--do-if-item
- (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--user-handles-get "block")))
- (mastodon-tl--do-if-item
- (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."
- (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unblock")))
- (if (not user-handle)
- (user-error "Looks like you have no blocks to unblock!")
- (mastodon-tl--do-user-action-and-response user-handle "unblock" t)))
-
-(defun mastodon-tl-mute-user (user-handle)
- "Query for USER-HANDLE from current status and mute that user."
- (interactive (list (mastodon-tl--user-handles-get "mute")))
- (mastodon-tl--do-if-item
- (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."
- (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unmute")))
- (if (not user-handle)
- (user-error "Looks like you have no mutes to unmute!")
- (mastodon-tl--do-user-action-and-response user-handle "unmute" t)))
-
-(defun mastodon-tl-dm-user (user-handle)
- "Query for USER-HANDLE from current status and compose a message to that user."
- (interactive (list (mastodon-tl--user-handles-get "message")))
- (mastodon-tl--do-if-item
- (mastodon-toot--compose-buffer (concat "@" user-handle))
- (setq mastodon-toot--visibility "direct")
- (mastodon-toot--update-status-fields)))
-
-(defun mastodon-tl--user-handles-get (action)
- "Get the list of user-handles for ACTION from the current toot."
- (mastodon-tl--do-if-item
- (let ((user-handles
- (cond
- ((or ; follow suggests / search / foll requests compat:
- (member (mastodon-tl--get-buffer-type)
- '( follow-suggestions search follow-requests
- ;; profile follows/followers but not statuses:
- profile-followers profile-following)))
- ;; fetch 'item-json:
- (list (alist-get 'acct
- (mastodon-tl--property 'item-json :no-move))))
- ;; profile view, point in profile details, poss 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
- (mastodon-profile--profile-json))))
- ;; (grouped) notifications:
- ((member (mastodon-tl--get-buffer-type) '(mentions notifications))
- (append ;; those acting on item:
- (cl-remove-duplicates
- (cl-loop for a in (mastodon-tl--property
- 'notification-accounts :no-move)
- collect (alist-get 'acct a)))
- ;; mentions in item:
- (mastodon-profile--extract-users-handles
- (mastodon-profile--item-json))))
- (t
- (mastodon-profile--extract-users-handles
- (mastodon-profile--item-json))))))
- (completing-read
- (cond ((or ; TODO: make this "enable/disable notifications"
- (string= action "disable")
- (string= action "enable"))
- (format "%s notifications when user posts: " action))
- ((string-suffix-p "boosts" action)
- (format "%s by user: " action))
- (t (format "Handle of user to %s: " action)))
- user-handles nil ; predicate
- 'confirm))))
-
-(defun mastodon-tl--get-blocks-or-mutes-list (action)
- "Fetch the list of accounts for ACTION from the server.
-Action must be either \"unblock\" or \"unmute\"."
- (let* ((endpoint (cond ((string= action "unblock")
- "blocks")
- ((string= action "unmute")
- "mutes")))
- (url (mastodon-http--api endpoint))
- (json (mastodon-http--get-json url))
- (accts (mastodon-tl--map-alist 'acct json)))
- (when accts
- (completing-read (format "Handle of user to %s: " action)
- accts nil :match))))
-
-(defun mastodon-tl--do-user-action-and-response
- (user-handle action &optional negp notify langs reblogs json)
- "Do ACTION on user USER-HANDLE.
-NEGP is whether the action involves un-doing something.
-If NOTIFY is \"true\", enable notifications when that user posts.
-If NOTIFY is \"false\", disable notifications when that user posts.
-NOTIFY is only non-nil when called by `mastodon-tl-follow-user'.
-LANGS is an array parameters alist of languages to filer user's posts by.
-REBLOGS is a boolean string like NOTIFY, enabling or disabling
-display of the user's boosts in your timeline."
- (let* ((account
- (cond
- (negp ;; unmuting/unblocking, use mute/block list
- (mastodon-profile--search-account-by-handle user-handle))
- ;; (grouped) notifications:
- ((member (mastodon-tl--get-buffer-type)
- '(mentions notifications))
- (let ((accounts (mastodon-tl--property 'notification-accounts)))
- (or (cl-some (lambda (x)
- (when (string= user-handle (alist-get 'acct x))
- x))
- accounts)
- (mastodon-profile--lookup-account-in-status
- user-handle
- (mastodon-profile--item-json)))))
- (t
- (mastodon-profile--lookup-account-in-status
- user-handle
- (if (mastodon-tl--profile-buffer-p)
- ;; profile view, use 'profile-json as status:
- (mastodon-profile--profile-json)
- ;; muting/blocking, select from handles in current status
- (mastodon-profile--item-json))))))
- (user-id (alist-get 'id account))
- (name (mastodon-tl--display-or-uname account))
- (args (cond (notify `(("notify" . ,notify)))
- (langs langs)
- (reblogs `(("reblogs" . ,reblogs)))
- (t nil)))
- (url (mastodon-http--api (format "accounts/%s/%s" user-id action))))
- (if (not account)
- (user-error "Cannot find a user with handle %S" user-handle)
- (when (or (string= action "follow") ;; y-or-n for all but follow
- (y-or-n-p (format "%s user %s? " action name)))
- (mastodon-tl--do-user-action-function
- url name user-handle action notify args reblogs json)))))
-
-(defun mastodon-tl--do-user-action-function
- (url name user-handle action &optional notify args reblogs json)
- "Post ACTION on user NAME/USER-HANDLE to URL.
-NOTIFY is either \"true\" or \"false\", and used when we have been called
-by `mastodon-tl-follow-user' to enable or disable notifications.
-ARGS is an alist of any parameters to send with the request."
- (let ((response (mastodon-http--post url args nil nil json)))
- (mastodon-http--triage
- response
- (lambda (response)
- (let ((json (with-current-buffer response
- (mastodon-http--process-json))))
- ;; TODO: when > if, with failure msg
- (cond ((string= notify "true")
- (when (eq t (alist-get 'notifying json))
- (message "Receiving notifications for user %s (@%s)!"
- name user-handle)))
- ((string= notify "false")
- (when (eq :json-false (alist-get 'notifying json))
- (message "Not receiving notifications for user %s (@%s)!"
- name user-handle)))
- ((string= reblogs "true")
- (when (eq t (alist-get 'showing_reblogs json))
- (message "Receiving boosts by user %s (@%s)!"
- name user-handle)))
- ((string= reblogs "false")
- (when (eq :json-false (alist-get 'showing_reblogs json))
- (message "Not receiving boosts by user %s (@%s)!"
- name user-handle)))
- ((or (string= action "mute")
- (string= action "unmute"))
- (message "User %s (@%s) %sd!" name user-handle action))
- ((string= args "languages[]")
- (message "User %s language filters removed!" name))
- ((assoc "languages[]" args #'string=)
- (message "User %s filtered by language(s): %s" name
- (mapconcat #'cdr args " ")))
- ((not (or notify reblogs))
- (if (and (string= action "follow")
- (eq t (alist-get 'requested json)))
- (message "Follow requested for user %s (@%s)!" name user-handle)
- (message "User %s (@%s) %sed!" name user-handle action)))))))))
-
-(defun mastodon-tl--get-domain-blocks ()
- "Return a list of current domain blocks."
- (mastodon-http--get-json
- (mastodon-http--api "domain_blocks")))
-
-(defun mastodon-tl-block-domain ()
- "Read a domain and block it."
- (interactive)
- (let* ((domain (read-string "Block domain: "))
- (params `(("domain" . ,domain)))
- (url (mastodon-http--api "domain_blocks"))
- (resp (mastodon-http--post url params)))
- (mastodon-http--triage
- resp
- (lambda (_)
- (message "Domain blocked!")))))
-
-(defun mastodon-tl-unblock-domain ()
- "Read a blocked domain and unblock it."
- (interactive)
- (let ((blocks (mastodon-tl--get-domain-blocks)))
- (if (not blocks)
- (user-error "No blocked domains?")
- (let* ((domain (completing-read "Unblock domain: "
- blocks))
- (params `(("domain" . ,domain)))
- (url (mastodon-http--api "domain_blocks"))
- (resp (mastodon-http--delete url params)))
- (mastodon-http--triage
- resp
- (lambda (_)
- (message "Domain unblocked!")))))))
-
-\f
-;; FOLLOW TAGS
-
-(defun mastodon-tl--get-tags-list ()
- "Return the list of tags of the toot at point."
- (let* ((toot (mastodon-toot--base-toot-or-item-json))
- (tags (mastodon-tl--field 'tags toot)))
- (mastodon-tl--map-alist 'name tags)))
-
-(defun mastodon-tl-follow-tag (&optional tag)
- "Prompt for a tag (from post at point) and follow it.
-If TAG provided, follow it."
- (interactive)
- (let* ((tags (unless tag (mastodon-tl--get-tags-list)))
- (tag-at-point
- (unless tag
- (when (eq 'hashtag
- (mastodon-tl--property 'mastodon-tab-stop :no-move))
- (mastodon-tl--property 'mastodon-tag :no-move))))
- (tag (or tag (completing-read
- (format "Tag to follow [%s]: " tag-at-point)
- tags nil nil nil nil tag-at-point)))
- (url (mastodon-http--api (format "tags/%s/follow" tag)))
- (response (mastodon-http--post url)))
- (mastodon-http--triage response
- (lambda (_)
- (message "tag #%s followed!" tag)))))
-
-(defun mastodon-tl--followed-tags ()
- "Return JSON of tags followed."
- (let ((url (mastodon-http--api (format "followed_tags"))))
- (mastodon-http--get-json url)))
-
-(defun mastodon-tl-unfollow-tag (&optional tag)
- "Prompt for a followed tag, and unfollow it.
-If TAG is provided, unfollow it."
- (interactive)
- (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags)))
- (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)))
- (response (mastodon-http--post url)))
- (mastodon-http--triage response
- (lambda (_)
- (message "tag #%s unfollowed!" tag)))))
-
-(defun mastodon-tl-jump-to-followed-tag (&optional prefix)
- "Prompt for a followed tag and view its timeline.
-PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
- (interactive "p")
- (let* ((followed-tags-json (mastodon-tl--followed-tags))
- (tags (mastodon-tl--map-alist 'name followed-tags-json))
- (tag (completing-read "Tag: " tags nil)))
- (if (null tag)
- (user-error "You have to follow some tags first")
- (mastodon-tl-get-tag-timeline prefix tag))))
-
-(defun mastodon-tl-list-followed-tags ()
- "List followed tags. View timeline of tag user choses.
-PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
- (interactive)
- (let* ((json (mastodon-tl--followed-tags))
- (sorted (cl-sort json #'string-lessp
- :key (lambda (x)
- (downcase (alist-get 'name x)))))
- (buf "*mastodon-followed-tags*"))
- (if (null sorted)
- (user-error "You have to follow some tags first")
- (with-mastodon-buffer (get-buffer-create buf)
- #'mastodon-mode nil
- (mastodon-tl--set-buffer-spec
- buf "followed_tags" #'mastodon-tl-list-followed-tags)
- (mastodon-search--insert-heading "followed tags")
- (insert "\n")
- (mastodon-search--print-tags sorted)
- (goto-char (point-min))))))
-
-(defun mastodon-tl-followed-tags-timeline (&optional prefix)
- "Open a timeline of multiple tags.
-With a single PREFIX arg, only show posts with media.
-With a double PREFIX arg, limit results to your own instance.
-If `mastodon-tl--tag-timeline-tags' is set, use its tags, else
-fetch followed tags and load the first four of them."
- (interactive "p")
- (let* ((followed-tags-json (mastodon-tl--followed-tags))
- (tags (or mastodon-tl--tag-timeline-tags
- (mastodon-tl--map-alist 'name followed-tags-json))))
- (mastodon-tl--show-tag-timeline prefix tags)))
-
-(defun mastodon-tl-some-followed-tags-timeline (&optional prefix)
- "Prompt for some tags, and open a timeline for them.
-The suggestions are from followed tags, but any other tags are also allowed.
-PREFIX is for `mastodon-tl--show-tag-timeline', which see."
- (interactive "p")
- (let* ((followed-tags-json (mastodon-tl--followed-tags))
- (tags (mastodon-tl--map-alist 'name followed-tags-json))
- (selection (completing-read-multiple
- "Tags' timelines to view [TAB to view, comma to separate]: "
- tags)))
- (mastodon-tl--show-tag-timeline prefix selection)))
-
-(defcustom mastodon-tl--tags-groups nil
- "A list containing lists of up to four tags each.
-You can load a tag timeline list with one of these by calling
-`mastodon-tl-tag-group-timeline'."
- :group 'mastodon-tl
- :type '(repeat (list string string string string)))
-
-(defun mastodon-tl-tag-group-timeline (&optional prefix)
- "Load a timeline of a tag group from `mastodon-tl--tags-groups'.
-PREFIX is for `mastodon-tl--show-tag-timeline', which see."
- (interactive "P")
- (if (not mastodon-tl--tags-groups)
- (user-error
- "Set `mastodon-tl--tags-groups' to view tag group timelines")
- (let* ((list-strs (mapcar (lambda (x)
- ;; cons of list-as-string and list:
- (cons (prin1-to-string x) x))
- mastodon-tl--tags-groups))
- (choice (completing-read "Tag group: " list-strs))
- (choice-list (cdr (assoc choice list-strs #'equal))))
- (mastodon-tl--show-tag-timeline prefix choice-list))))
-
-\f
-;;; REPORT TO MODERATORS
-
-(defun mastodon-tl--instance-rules ()
- "Return the rules of the user's instance."
- (let ((url (mastodon-http--api "instance/rules")))
- (mastodon-http--get-json url nil :silent)))
-
-(defun mastodon-tl--report-params (account toot)
- "Query user and return report params alist.
-ACCOUNT and TOOT are the data to use."
- (let* ((account-id (alist-get 'id account))
- (comment (read-string "Add comment [optional]: "))
- (item-id (when (y-or-n-p "Also report status at point? ")
- (mastodon-tl--item-id toot))) ; base toot if poss
- (forward-p (when (y-or-n-p "Forward to remote admin? ") "true"))
- (rules (when (y-or-n-p "Cite a rule broken? ")
- (mastodon-tl--read-rules-ids)))
- (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other"))))
- (mastodon-tl--report-build-params account-id comment item-id
- forward-p cat rules)))
-
-(defun mastodon-tl--report-build-params
- (account-id comment item-id forward-p cat &optional rules)
- "Build the parameters alist based on user responses.
-ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from
-`mastodon-tl--report-params', which see."
- (let ((params
- `(("account_id" . ,account-id)
- ,@(when comment `(("comment" . ,comment)))
- ,@(when item-id `(("status_ids[]" . ,item-id)))
- ,@(when forward-p `(("forward" . ,forward-p)))
- ,@(when cat `(("category" . ,cat))))))
- (if (not rules)
- params
- (let ((alist
- (mastodon-http--build-array-params-alist "rule_ids[]" rules)))
- (append alist params)))))
-
-(defun mastodon-tl-report-to-mods ()
- "Report the author of the toot at point to your instance moderators.
-Optionally report the toot at point, add a comment, cite rules
-that have been broken, forward the report to the remove admin,
-report the account for spam."
- (interactive)
- (mastodon-tl--do-if-item
- (when (y-or-n-p "Report author of toot at point?")
- (let* ((url (mastodon-http--api "reports"))
- (toot (mastodon-tl--toot-or-base
- (mastodon-tl--property 'item-json :no-move)))
- (account (alist-get 'account toot))
- (handle (alist-get 'acct account))
- (params (mastodon-tl--report-params account toot))
- (response (mastodon-http--post url params)))
- (mastodon-http--triage response
- (lambda (_)
- (message "User %s reported!" handle)))))))
-
-(defvar crm-separator)
-
-(defun mastodon-tl--map-rules-alist (rules)
- "Convert RULES text and id fields into an alist."
- (mastodon-tl--map-alist-vals-to-alist 'text 'id rules))
-
-(defun mastodon-tl--read-rules-ids ()
- "Prompt for a list of instance rules and return a list of selected ids."
- (let* ((rules (mastodon-tl--instance-rules))
- (alist (mastodon-tl--map-rules-alist rules))
- (crm-separator (replace-regexp-in-string "," "|" crm-separator))
- (choices (completing-read-multiple
- "rules [TAB for options, | to separate]: "
- alist nil t)))
- (mapcar (lambda (x)
- (alist-get x alist nil nil #'string=))
- choices)))
-
-\f
-;;; UPDATING, etc.
-
-(defun mastodon-tl--no-json (json)
- "Nil if JSON is nil or empty group notif data."
- (if (and (mastodon-tl--buffer-type-eq 'notifications)
- mastodon-group-notifications)
- (mastodon-notifications--empty-group-json-p json)
- (not json)))
-
-(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 (append args params))
- (url (mastodon-http--api
- endpoint
- (when (or (and mastodon-group-notifications
- (string= endpoint "notifications"))
- (string-suffix-p "search" endpoint))
- "v2"))))
- (apply #'mastodon-http--get-json-async url args callback cbargs)))
-
-(defun mastodon-tl--more-json-async-offset (endpoint &optional params
- callback &rest cbargs)
- "Return JSON for ENDPOINT, using the \"offset\" query param.
-This is used for pagination with endpoints that implement the
-\"offset\" parameter, rather than using link-headers or
-\"max_id\".
-PARAMS are the update parameters, see
-`mastodon-tl--update-params'. These (\"limit\" and \"offset\")
-must be set in `mastodon-tl--buffer-spec' for pagination to work.
-Then run CALLBACK with arguments CBARGS."
- (let* ((params (or params (mastodon-tl--update-params)))
- (limit (string-to-number
- (alist-get "limit" params nil nil #'string=)))
- (offset (number-to-string
- (+ limit ; limit + old offset = new offset
- (string-to-number
- (alist-get "offset" params nil nil #'string=)))))
- (url (mastodon-http--api
- endpoint
- (when (string-suffix-p "search" endpoint)
- "v2"))))
- ;; increment:
- (setf (alist-get "offset" params nil nil #'string=) offset)
- (apply #'mastodon-http--get-json-async url params callback cbargs)))
-
-(defun mastodon-tl--updated-json (endpoint id &optional params version)
- "Return JSON for timeline ENDPOINT since ID.
-PARAMS is used to send any parameters needed to correctly update
-the current view.
-VERSION is the API version to use, as grouped notifs use v2."
- (let* ((args `(("since_id" . ,(mastodon-tl--as-string id))))
- (args (append args params))
- (url (mastodon-http--api endpoint version)))
- (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 (&optional pos)
- "Reload the current timeline or profile page.
-For use after e.g. deleting a toot.
-POS is a number, where point will be placed.
-Aims to respect any pagination in effect."
- (let ((type (mastodon-tl--get-buffer-type))
- (max-id (mastodon-tl--buffer-property 'max-id nil :no-error)))
- (cond ((eq type 'home)
- (mastodon-tl-get-home-timeline nil max-id))
- ((eq type 'federated)
- (mastodon-tl-get-federated-timeline nil nil max-id))
- ((eq type 'local)
- (mastodon-tl-get-local-timeline nil max-id))
- ((eq type 'mentions)
- (mastodon-notifications-get-mentions))
- ((eq type 'notifications)
- (mastodon-notifications-get nil nil max-id))
- ((eq type 'profile-statuses-no-boosts)
- ;; TODO: max-id arg needed here also
- (mastodon-profile-open-statuses-no-reblogs))
- ((eq type 'profile-statuses)
- (save-excursion
- (goto-char (point-min))
- (mastodon-profile--make-author-buffer
- ;; (mastodon-profile-get-toot-author max-id)))
- (mastodon-profile--profile-json))))
- ((or (eq type 'single-status)
- (eq type 'thread))
- (let ((id (mastodon-tl--buffer-property
- 'thread-item-id (current-buffer) :no-error)))
- (mastodon-tl--thread-do id))))
- ;; TODO: sends point to where point was in buffer. This is very rough; we
- ;; may have removed an item , so the buffer will be smaller, point will
- ;; end up past where we were, etc.
- (when pos
- (goto-char pos)
- (mastodon-tl-goto-prev-item :no-refresh))))
-
-(defun mastodon-tl--build-link-header-url (str)
- "Return a URL from STR, an http Link header."
- (let* ((split (split-string str "; "))
- (url-base (string-trim (car split) "<" ">"))
- (param (cadr split)))
- (concat url-base "&" param)))
-
-(defun mastodon-tl--use-link-header-p ()
- "Return t if we are in a view needing Link header pagination.
-Currently this includes favourites, bookmarks, follow requests,
-and profile pages when showing followers or accounts followed."
- (or (mastodon-tl--buffer-type-eq 'favourites)
- (mastodon-tl--buffer-type-eq 'bookmarks)
- (mastodon-tl--buffer-type-eq 'profile-followers)
- (mastodon-tl--buffer-type-eq 'profile-following)
- (mastodon-tl--buffer-type-eq 'follow-requests)))
-
-(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."
- (message "Loading...")
- (if (mastodon-tl--use-link-header-p)
- ;; link-header paginate:
- ;; can't build a URL with --more-json-async, endpoint/id:
- ;; ensure we have a "next" type here, otherwise the CAR will be the
- ;; "prev" type!
- (let ((link-header (mastodon-tl--link-header)))
- (if (> 2 (length link-header))
- (user-error "No next page")
- (let* ((next (car link-header))
- ;;(prev (cadr (mastodon-tl--link-header)))
- (url (mastodon-tl--build-link-header-url next)))
- (mastodon-http--get-response-async
- url nil 'mastodon-tl--more* (current-buffer) (point) :headers))))
- (cond (;; no paginate
- (or (mastodon-tl--buffer-type-eq 'follow-suggestions)
- (mastodon-tl--buffer-type-eq 'filters)
- (mastodon-tl--buffer-type-eq 'lists))
- (user-error "No more results"))
- ;; offset paginate (search, trending, user lists, ...?):
- ((or (string-prefix-p "*mastodon-trending-" (buffer-name))
- (mastodon-tl--search-buffer-p))
- (mastodon-tl--more-json-async-offset
- (mastodon-tl--endpoint)
- (mastodon-tl--update-params)
- 'mastodon-tl--more* (current-buffer) (point)))
- (t ;; max_id paginate (timelines, items with ids/timestamps):
- (let ((max-id (mastodon-tl--oldest-id))
- (params (mastodon-tl--update-params)))
- (mastodon-tl--more-json-async
- (mastodon-tl--endpoint)
- max-id params
- 'mastodon-tl--more*
- (current-buffer) (point) nil max-id))))))
-
-(defun mastodon-tl--more*
- (response buffer point-before &optional headers max-id)
- "Append older toots to timeline, asynchronously.
-Runs the timeline's update function on RESPONSE, in BUFFER.
-When done, places point at POINT-BEFORE.
-HEADERS is the http headers returned in the response, if any.
-MAX-ID is the pagination parameter, a string.
-UPDATE-PARAMS is from prev buffer spec, added to the new one."
- (with-current-buffer buffer
- (if (not response)
- (user-error "No more results")
- (let* ((inhibit-read-only t)
- (json (if headers (car response) response))
- ;; FIXME: max-id pagination works for statuses only, not other
- ;; search results pages:
- (json (if (not (mastodon-tl--search-buffer-p))
- json
- (let ((type (mastodon-search--buf-type)))
- (cond ((string= "statuses" type)
- (cdr ; avoid repeat of last status
- (alist-get 'statuses response)))
- ((string= "hashtags" type)
- (alist-get 'hashtags response))
- ((string= "accounts" type)
- (alist-get 'accounts response))))))
- (headers (when headers (cdr response)))
- (link-header
- (mastodon-tl--get-link-header-from-response headers))
- (buf-type (mastodon-tl--get-buffer-type))
- (notifs-p (or (eq buf-type 'notifications)
- (eq buf-type 'mentions)))
- (notif-type (when notifs-p
- (mastodon-notifications--current-type))))
- (goto-char (point-max))
- (if (eq 'thread buf-type)
- ;; if thread fully unfolded, respect it:
- ;; if thread view, call --thread-do with parent ID
- (progn (goto-char (point-min))
- (mastodon-tl-goto-next-item)
- (mastodon-tl--thread-do)
- (goto-char point-before)
- (message "Loaded full thread."))
- (if (mastodon-tl--no-json json)
- (user-error "No more results")
- (if notifs-p
- (mastodon-notifications--timeline json notif-type :update)
- (funcall (mastodon-tl--update-function) json))
- (goto-char point-before)
- ;; update buffer spec to new link-header or max-id:
- ;; (other values should just remain as they were)
- (mastodon-tl--set-buffer-spec
- (mastodon-tl--buffer-name)
- (mastodon-tl--endpoint)
- (mastodon-tl--update-function)
- link-header (mastodon-tl--update-params)
- (mastodon-tl--hide-replies-p) max-id)
- (message "Loading... done.")))))))
-
-(defun mastodon-tl--find-property-range (property start-point
- &optional search-backwards)
- "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)
- ;; We are within a range, so look backwards for the start:
- (cons (previous-single-property-change
- (if (eq start-point (point-max)) start-point (1+ start-point))
- property nil (point-min))
- (next-single-property-change start-point property nil (point-max)))
- (if search-backwards
- (let* ((end (or (previous-single-property-change
- (if (eq start-point (point-max))
- start-point
- (1+ start-point))
- property)
- ;; we may either be just before the range or there
- ;; is nothing at all
- (and (not (eq start-point (point-min)))
- (get-text-property (1- start-point) property)
- start-point)))
- (start (and end (previous-single-property-change
- end property nil (point-min)))))
- (when end
- (cons start end)))
- (let* ((start (next-single-property-change start-point property))
- (end (and start (next-single-property-change
- start property nil (point-max)))))
- (when start
- (cons start end))))))
-
-(defun mastodon-tl--find-next-or-previous-property-range
- (property start-point search-backwards)
- "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 (not (get-text-property start-point property))
- ;; If we are not within a range, we can just defer to
- ;; mastodon-tl--find-property-range directly.
- (mastodon-tl--find-property-range property start-point search-backwards)
- ;; We are within a range, we need to start the search from
- ;; before/after this range:
- (let ((current-range
- (mastodon-tl--find-property-range property start-point)))
- (if search-backwards
- (unless (eq (car current-range) (point-min))
- (mastodon-tl--find-property-range
- property (1- (car current-range)) search-backwards))
- (unless (eq (cdr current-range) (point-max))
- (mastodon-tl--find-property-range
- property (1+ (cdr current-range)) search-backwards))))))
-
-(defun mastodon-tl--consider-timestamp-for-updates (timestamp)
- "Take note that TIMESTAMP is used in buffer and ajust timers as needed.
-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 (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
- (time-subtract mastodon-tl--timestamp-next-update
- (seconds-to-time 10)))
- (setq mastodon-tl--timestamp-next-update this-update)
- (when mastodon-tl--timestamp-update-timer
- ;; We need to re-schedule for an earlier time
- (cancel-timer mastodon-tl--timestamp-update-timer)
- (setq mastodon-tl--timestamp-update-timer
- (run-at-time (time-to-seconds (time-subtract this-update
- (current-time)))
- nil ;; don't repeat
- #'mastodon-tl--update-timestamps-callback
- (current-buffer) nil)))))))
-
-(defun mastodon-tl--update-timestamps-callback (buffer previous-marker)
- "Update the next few timestamp displays in BUFFER.
-Start searching for more timestamps from PREVIOUS-MARKER or
-from the start if it is nil."
- ;; only do things if the buffer hasn't been killed in the meantime
- (when (and mastodon-tl--enable-relative-timestamps ; just in case
- (buffer-live-p buffer))
- (save-excursion
- (with-current-buffer buffer
- (let ((previous-timestamp (if previous-marker
- (marker-position previous-marker)
- (point-min)))
- (iteration 0)
- next-timestamp-range)
- (if previous-marker
- ;; a follow-up call to process the next batch of timestamps.
- ;; Release the marker to not slow things down.
- (set-marker previous-marker nil)
- ;; Otherwise this is a rew run, so let's initialize the next-run time.
- (setq mastodon-tl--timestamp-next-update (time-add (current-time)
- (seconds-to-time 300))
- mastodon-tl--timestamp-update-timer nil))
- (while (and (< iteration 5)
- (setq next-timestamp-range
- (mastodon-tl--find-property-range 'timestamp
- previous-timestamp)))
- (let* ((start (car next-timestamp-range))
- (end (cdr next-timestamp-range))
- (timestamp (get-text-property start 'timestamp))
- (current-display (get-text-property start 'display))
- (new-display (mastodon-tl--relative-time-description timestamp)))
- (unless (string= current-display new-display)
- (let ((inhibit-read-only t))
- (add-text-properties
- start end
- (list 'display
- (mastodon-tl--relative-time-description timestamp)))))
- (mastodon-tl--consider-timestamp-for-updates timestamp)
- (setq iteration (1+ iteration)
- previous-timestamp (1+ (cdr next-timestamp-range)))))
- (if next-timestamp-range
- ;; schedule the next batch from the previous location to
- ;; start very soon in the future:
- (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer
- (copy-marker previous-timestamp))
- ;; otherwise we are done for now; schedule a new run for when needed
- (setq mastodon-tl--timestamp-update-timer
- (run-at-time (time-to-seconds
- (time-subtract mastodon-tl--timestamp-next-update
- (current-time)))
- nil ;; don't repeat
- #'mastodon-tl--update-timestamps-callback
- buffer nil))))))))
-
-(defun mastodon-tl--set-after-update-marker ()
- "Set `mastodon-tl--after-update-marker' to the after-update location.
-This location is defined by a non-nil value of
-`mastodon-tl-position-after-update'."
- (if (not mastodon-tl-position-after-update)
- (setq mastodon-tl--after-update-marker nil)
- (let ((marker (make-marker)))
- (set-marker marker
- (cond
- ((eq 'keep-point mastodon-tl-position-after-update)
- (point))
- ((eq 'last-old-toot mastodon-tl-position-after-update)
- (next-single-property-change
- (or mastodon-tl--update-point (point-min))
- 'byline))
- (t
- (error "Unknown mastodon-tl-position-after-update value %S"
- mastodon-tl-position-after-update))))
- ;; Make the marker advance if text gets inserted there.
- (set-marker-insertion-type marker t)
- (setq mastodon-tl--after-update-marker marker))))
-
-(defun mastodon-tl-update ()
- "Update timeline with new toots."
- (interactive)
- ;; FIXME: actually these buffers should just reload by calling their own
- ;; load function (actually g is mostly mapped as such)
- ;; well actually, g should be for reload, update is different.
- (if (or (member (mastodon-tl--get-buffer-type)
- '(trending-statuses
- trending-tags
- follow-suggestions
- lists
- filters
- scheduled-statuses))
- (mastodon-tl--search-buffer-p))
- (user-error "Update not available in this view")
- ;; FIXME: handle update for search and trending buffers
- (let* ((endpoint (mastodon-tl--endpoint))
- (update-fun (mastodon-tl--update-function))
- (id (mastodon-tl--newest-id)))
- ;; update a thread, without calling `mastodon-tl--updated-json':
- (if (mastodon-tl--buffer-type-eq 'thread)
- ;; load whole thread:
- (progn (mastodon-tl--thread-do id)
- (message "Loaded full thread."))
- (if (not id) ;; if e.g. notifs all cleared:
- (user-error "No last id")
- ;; update other timelines:
- (let* ((params (mastodon-tl--update-params))
- (notifs-p
- (eq update-fun 'mastodon-notifications--timeline))
- (json (mastodon-tl--updated-json
- endpoint id params
- (when (and notifs-p mastodon-group-notifications)
- "v2"))))
- (if (mastodon-tl--no-json json)
- (user-error "Nothing to update")
- (let ((inhibit-read-only t))
- (mastodon-tl--set-after-update-marker)
- (goto-char (or mastodon-tl--update-point (point-min)))
- (if notifs-p
- (funcall update-fun json nil :update)
- (funcall update-fun json))
- (if mastodon-tl--after-update-marker
- (goto-char mastodon-tl--after-update-marker)
- (mastodon-tl-goto-next-item))))))))))
-
-\f
-;;; LOADING TIMELINES
-
-(defun mastodon-tl--init
- (buffer-name endpoint update-function &optional headers params
- hide-replies instance no-byline)
- "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously.
-UPDATE-FUNCTION is used to recieve more toots.
-HEADERS means to also collect the response headers. Used for paginating
-favourites and bookmarks.
-PARAMS is any parameters to send with the request.
-HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer.
-INSTANCE is a string of another instance domain we are displaying
-a timeline from.
-NO-BYLINE means just insert toot body, used for announcements."
- (let ((url (if instance
- (concat "https://" instance "/api/v1/" endpoint)
- (mastodon-http--api endpoint)))
- (buffer (concat "*mastodon-" buffer-name "*")))
- (funcall
- (if headers
- #'mastodon-http--get-response-async
- #'mastodon-http--get-json-async)
- url params 'mastodon-tl--init*
- buffer endpoint update-function headers params hide-replies
- instance no-byline)))
-
-(defun mastodon-tl--init*
- (response buffer endpoint update-function &optional headers
- update-params hide-replies instance no-byline)
- "Initialize BUFFER with timeline targeted by ENDPOINT.
-UPDATE-FUNCTION is used to recieve more toots.
-RESPONSE is the data returned from the server by
-`mastodon-http--process-json', with arg HEADERS a cons cell of
-JSON and http headers, without it just the JSON.
-NO-BYLINE means just insert toot body, used for announcements."
- (let ((json (if headers (car response) response)))
- (cond ((not json) ; praying this is right here, else try "\n[]"
- ;; this means that whatever tl was inited won't load, which is not
- ;; always wanted, as sometimes you still need the page to load so
- ;; you can be in eg mastodon-mode, have keymap, search etc.
- (message "Looks like nothing returned from endpoint: %s" endpoint)
- ;; if we are a new account, home tl may have nothing, but then
- ;; this clause means we can never load mastodon.el at all!
- ;; so as a fallback, load trending statuses:
- ;; FIXME: this could possibly be a fallback for all timelines not
- ;; just home?
- (when (string= endpoint "timelines/home")
- (mastodon-search-trending-statuses)))
- ((eq (caar json) 'error)
- (user-error "Looks like the server bugged out: \"%s\"" (cdar json)))
- (t
- (let* ((headers (when headers (cdr response)))
- (link-header
- (mastodon-tl--get-link-header-from-response headers)))
- (with-mastodon-buffer buffer #'mastodon-mode nil
- (mastodon-tl--set-buffer-spec
- buffer endpoint update-function
- link-header update-params hide-replies
- ;; awful hack to fix multiple reloads:
- (alist-get "max_id" update-params nil nil #'string=))
- (mastodon-tl--do-init json update-function instance no-byline)))))))
-
-(defun mastodon-tl--init-sync
- (buffer-name endpoint update-function &optional note-type params
- headers view-name binding-str endpoint-version)
- "Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
-UPDATE-FUNCTION is used to receive more toots.
-Runs synchronously.
-Optional arg NOTE-TYPE means only get that type of notification.
-PARAMS is an alist of any params to include in the request.
-HEADERS are any headers to send in the request.
-VIEW-NAME is a string, to be used as a heading for the view.
-BINDING-STR is a string explaining any bindins in the view, it can have
-formatting for `substitute-command-keys'.
-ENDPOINT-VERSION is a string, format Vx, e.g. V2."
- ;; Used by `mastodon-notifications-get' and in views.el
- (let* ((notes-params (when note-type
- (mastodon-http--build-array-params-alist
- "types[]" (list note-type))))
- (params (append notes-params params))
- (url (mastodon-http--api endpoint endpoint-version))
- (buffer (concat "*mastodon-" buffer-name "*"))
- (response (mastodon-http--get-response url params))
- (json (car response))
- (headers (when headers (cdr response)))
- (link-header (when headers
- (mastodon-tl--get-link-header-from-response headers))))
- (with-mastodon-buffer buffer #'mastodon-mode nil
- ;; insert view-name/ heading-str
- (when view-name
- (mastodon-search--insert-heading view-name))
- (when binding-str
- (insert
- (substitute-command-keys
- (mastodon-tl--set-face (concat "[" binding-str "]\n\n")
- 'mastodon-toot-docs-face))))
- (mastodon-tl--set-buffer-spec
- buffer endpoint update-function
- link-header params nil
- ;; awful hack to fix multiple reloads:
- (alist-get "max_id" params nil nil #'string=))
- (mastodon-tl--do-init json update-function nil nil note-type)
- buffer)))
-
-(defun mastodon-tl--do-init (json update-fun &optional domain no-byline type)
- "Utility function for `mastodon-tl--init*' and `mastodon-tl--init-sync'.
-JSON is the data to call UPDATE-FUN on.
-When DOMAIN, force inclusion of user's domain in their handle.
-NO-BYLINE means just insert toot body, used for announcements.
-TYPE is a notification type."
- (remove-overlays) ; video overlays
- (cond (domain ;; maybe our update-fun doesn't always have 3 args...:
- (funcall update-fun json nil domain))
- (type (funcall update-fun json type)) ;; notif types
- (no-byline (funcall update-fun json nil nil no-byline))
- (t (funcall update-fun json)))
- (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)))
- (setq mastodon-tl--timestamp-update-timer
- (when mastodon-tl--enable-relative-timestamps
- (run-at-time (time-to-seconds
- (time-subtract mastodon-tl--timestamp-next-update
- (current-time)))
- nil ;; don't repeat
- #'mastodon-tl--update-timestamps-callback
- (current-buffer)
- nil)))
- (unless (mastodon-tl--profile-buffer-p)
- (mastodon-tl--goto-first-item)))
-
-;;; NODEINFO
-
-(defun mastodon-tl--get-nodeinfo (instance &optional version)
- "Return Nodeinfo data for INSTANCE, optionally for version."
- ;; NB: not in the API:
- (let ((url (format "https://%s/nodeinfo/%s" instance (or version "2.0"))))
- (mastodon-http--get-json url)))
-
-(defun mastodon-tl-nodeinfo-for-toot ()
- "Return Nodeinfo for toot at point.
-Displays what software and version an instance is running.
-Also the instances description and usage stats, etc.
-Nodeinfo is a data standard for distributed social networks, see
-https://nodeinfo.diaspora.software."
- (interactive)
- (let* ((item (mastodon-tl--property 'item-json))
- (url (mastodon-tl--field 'url item))
- (instance (url-host (url-generic-parse-url url)))
- (data (mastodon-tl--get-nodeinfo instance)))
- (when data ;; don't display empty message when fetching failed
- (if (eq 'error (caar data))
- (user-error "Error: %s" (alist-get 'error data))
- (mastodon-tl--render-nodeinfo data)))))
-
-(defun mastodon-tl--render-nodeinfo (data)
- "Render Nodeinfo DADA as message."
- (let-alist data
- (message
- "%s"
- (concat "Software: "
- .software.name " " .software.version
- (if (not .metadata)
- ""
- (concat
- "\nInstance: "
- .metadata.nodeName " " .metadata.nodeDescription))))))
-
-;;; BOOKMARKS
-
-(require 'bookmark)
-
-(defun mastodon-tl--bookmark-handler (record)
- "Jump to a bookmarked location in mastodon.el.
-RECORD is the bookmark record."
- (let ((id (bookmark-prop-get record 'id)))
- ;; we need to handle thread and single toot for starters
- (pop-to-buffer
- (mastodon-tl--thread-do id))))
-
-(defun mastodon-tl--bookmark-make-record ()
- "Return a bookmark record for the current mastodon buffer."
- (let ((id (mastodon-tl--property 'item-id :no-move))
- (name (buffer-name)))
- `(,name
- (buf . ,name)
- (id . ,id)
- (handler . mastodon-tl--bookmark-handler))))
-
-(add-hook 'mastodon-mode-hook
- (lambda ()
- (setq-local bookmark-make-record-function
- #'mastodon-tl--bookmark-make-record)))
-
-(provide 'mastodon-tl)
-;;; mastodon-tl.el ends here
+++ /dev/null
-;;; mastodon-toot.el --- Minor mode for sending Mastodon toots -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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-toot.el supports POSTing status data to Mastodon.
-
-;;; Code:
-(eval-when-compile (require 'subr-x))
-
-
-(defvar mastodon-use-emojify)
-(require 'emojify nil :noerror)
-(declare-function emojify-insert-emoji "emojify")
-(declare-function emojify-set-emoji-data "emojify")
-(declare-function emojify-mode "emojify")
-(declare-function emojify-emojis-each "emojify")
-(defvar emojify-emojis-dir)
-(defvar emojify-user-emojis)
-(defvar emojify-emoji-styles)
-
-(require 'cl-lib)
-(require 'persist)
-(require 'mastodon-iso)
-(require 'facemenu)
-(require 'text-property-search)
-
-(eval-when-compile
- (require 'mastodon-tl))
-
-(defvar mastodon-instance-url)
-(defvar mastodon-tl--buffer-spec)
-(defvar mastodon-tl--enable-proportional-fonts)
-(defvar mastodon-profile-account-settings)
-(defvar mastodon-profile-acccount-preferences-data)
-
-(autoload 'iso8601-parse "iso8601")
-(autoload 'ht-get "ht")
-(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-kill-window "mastodon")
-(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--field "mastodon-tl")
-(autoload 'mastodon-tl--find-property-range "mastodon-tl")
-(autoload 'mastodon-tl--find-property-range "mastodon-tl")
-(autoload 'mastodon-tl-goto-next-item "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--render-text "mastodon-tl")
-(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
-(autoload 'mastodon-tl--symbol "mastodon-tl")
-(autoload 'mastodon-tl--item-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 'mastodon-tl--toot-or-base "mastodon-tl")
-(autoload 'mastodon-profile--get-source-value "mastodon-toot")
-(autoload 'mastodon-tl--get-buffer-type "mastodon-tl")
-(autoload 'mastodon-tl--human-duration "mastodon-tl")
-(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile")
-(autoload 'mastodon-views--get-own-instance "mastodon-views")
-(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
-(autoload 'mastodon-instance-data "mastodon")
-(autoload 'mastodon-create-poll "mastodon-transient")
-(autoload 'mastodon-tl--own-profile-buffer-p "mastodon-tl")
-
-;; 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-"
- :group 'mastodon)
-
-(defcustom mastodon-toot--default-media-directory "~/"
- "The default directory when prompting for a media file to upload."
- :type 'string)
-
-(defcustom mastodon-toot--attachment-height 80
- "Height of the attached images preview in the toot draft buffer."
- :type 'integer)
-
-(defcustom mastodon-toot--enable-completion t
- "Whether to enable completion of mentions and hashtags.
-Used for completion in toot compose buffer."
- :type 'boolean)
-
-(defcustom mastodon-toot--use-company-for-completion nil
- "Whether to enable company for completion.
-When non-nil, `company-mode' is enabled in the toot compose
-buffer, and mastodon completion backends are added to
-`company-capf'.
-
-You need to install company yourself to use this."
- :type 'boolean)
-
-(defcustom mastodon-toot--completion-style-for-mentions "all"
- "The company completion style to use for mentions."
- :type '(choice
- (const :tag "off" nil)
- (const :tag "following only" "following")
- (const :tag "all users" "all")))
-
-(defcustom mastodon-toot-display-orig-in-reply-buffer nil
- "Display a copy of the toot replied to in the compose buffer."
- :type 'boolean)
-
-(defcustom mastodon-toot-orig-in-reply-length 191
- ;; three lines of divider width: (- (* 3 67) (length " Reply to: "))
- "Length to crop toot replied to in the compose buffer to."
- :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."
- :type '(choice
- (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."
- :type 'boolean)
-
-(defcustom mastodon-toot--proportional-fonts-compose nil
- "Nonnil to enable using proportional fonts in the compose buffer.
-By default fixed width fonts are used."
- :type '(boolean :tag "Enable using proportional rather than fixed \
-width fonts"))
-
-(defcustom mastodon-toot-poll-use-transient t
- "Whether to use the transient menu to create a poll."
- :type '(boolean))
-
-(defvar-local mastodon-toot--content-warning nil
- "The content warning of the current toot.")
-
-(defvar-local mastodon-toot--content-nsfw nil
- "A flag indicating whether the toot should be marked as NSFW.")
-
-(defvar mastodon-toot-visibility-list
- '(public unlisted private direct)
- "A list of the available toot visibility settings.")
-
-(defvar mastodon-toot-visibility-settings-list
- '("public" "unlisted" "private")
- "A list of the available default toot visibility settings.
-Like `mastodon-toot-visibility-list' but without direct.")
-
-(defvar-local mastodon-toot--visibility nil
- "A string indicating the visibility of the toot being composed.
-Valid values are \"direct\", \"private\" (followers-only),
-\"unlisted\", and \"public\".
-
-This is determined by the account setting on the server. To
-change the setting on the server, see
-`mastodon-toot-set-default-visibility'.")
-
-(defvar-local mastodon-toot--media-attachments nil
- "A list of the media attachments of the toot being composed.")
-
-(defvar-local mastodon-toot--media-attachment-ids nil
- "A list of any media attachment ids of the toot being composed.")
-
-(defvar mastodon-toot-poll nil
- "A plist of poll options for the toot being composed.")
-
-(defvar-local mastodon-toot--language nil
- "The language of the toot being composed, in ISO 639 (two-letter).")
-
-(defvar-local mastodon-toot--scheduled-for nil
- "An ISO 8601 timestamp that specifying when the post should be published.
-Should be at least 5 minutes into the future.")
-
-(defvar-local mastodon-toot--scheduled-id nil
- "The id of the scheduled post that we are now editing.")
-
-(defvar-local mastodon-toot--reply-to-id nil
- "Buffer-local variable to hold the id of the toot being replied to.")
-
-(defvar-local mastodon-toot--edit-item-id nil
- "The id of the toot being edited.")
-
-(defvar-local mastodon-toot-previous-window-config nil
- "A list of window configuration prior to composing a toot.
-Takes its form from `window-configuration-to-register'.")
-
-(defvar mastodon-toot--max-toot-chars nil
- "The maximum allowed characters count for a single toot.")
-
-(defvar-local mastodon-toot-completions nil
- "The data of completion candidates for the current completion at point.")
-
-(defvar mastodon-toot-current-toot-text nil
- "The text of the toot being composed.")
-
-(persist-defvar mastodon-toot-draft-toots-list nil
- "A list of toots that have been saved as drafts.
-For the moment we just put all composed toots in here, as we want
-to also capture toots that are \"sent\" but that don't successfully
-send.")
-
-\f
-;;; REGEXES
-
-(defvar mastodon-toot-handle-regex
- (rx (group-n 2 ; include domain
- (group-n 4 ; exclude domain
- (| (any ?\( "\n" "\t" " ") bol) ; preceding things
- ?@ ; first @
- (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; username
- (? ?@ (* (not (any "\n" "\t" " "))))) ; optional domain
- (| "'" word-boundary))) ; boundary or possessive
-
-(defvar mastodon-toot-tag-regex
- (rx (| (any ?\( "\n" "\t" " ") bol)
- (group-n 2 ?# (+ (any "_" "A-Z" "a-z" "0-9")))
- (| "'" word-boundary))) ; boundary or possessive
-
-(defvar mastodon-toot-emoji-regex
- (rx (| (any ?\( "\n" "\t" " ") bol)
- (group-n 2 ?: ; opening :
- (+ (any "A-Z" "a-z" "0-9" "_"))
- (? ?:)) ; closing :
- word-boundary)) ; boundary
-
-(defvar mastodon-toot-url-regex
- ;; adapted from ffap-url-regexp
- (concat
- "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix
- "[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars
- ;; "[ .,:;!?]\\b"))
- ;; "/" ; poss an ending slash? incompat with boundary end:
- "\\>")) ; boundary end
-
-\f
-;;; UTILS
-
-(defun mastodon-toot--base-toot-or-item-json ()
- "Return the JSON data of either base-toot or item-json property.
-The former is for boost or favourite notifications, returning
-data about the item boosted or favourited."
- (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs
- (mastodon-tl--property 'item-json)))
-
-(defun mastodon-toot--inc-or-dec (count subtract)
- "If SUBTRACT, decrement COUNT, else increment."
- (if subtract
- (1- count)
- (1+ count)))
-
-\f
-;;; MACRO
-
-(defmacro mastodon-toot--with-toot-item (&rest body)
- "Execute BODY if we have a toot object at point.
-Includes boosts, and notifications that display toots.
-This macro makes the local variable ID available."
- (declare (debug t))
- `(if (or (not (eq 'toot (mastodon-tl--property 'item-type :no-move)))
- (member (mastodon-tl--property 'notification-type :no-move)
- '("follow" "follow_request")))
- (user-error "Looks like there's no toot at point?")
- (mastodon-tl--with-toot-helper
- (lambda (id)
- ,@body))))
-
-(defun mastodon-tl--with-toot-helper (body-fun)
- "Helper function for `mastodon-tl--with-toot-item'.
-Extract any common variables needed, such as base-item-id
-property, and call BODY-FUN on them."
- (let ((id (mastodon-tl--property 'base-item-id)))
- (funcall body-fun id)))
-
-\f
-;;; MODE MAP
-
-(defvar mastodon-toot-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") #'mastodon-toot-send)
- (define-key map (kbd "C-c C-k") #'mastodon-toot-cancel)
- (define-key map (kbd "C-c C-w") #'mastodon-toot-set-content-warning)
- (define-key map (kbd "C-c C-n") #'mastodon-toot-toggle-nsfw)
- (define-key map (kbd "C-c C-v") #'mastodon-toot-change-visibility)
- (define-key map (kbd "C-c C-e") #'mastodon-toot-insert-emoji)
- (define-key map (kbd "C-c C-a") #'mastodon-toot-attach-media)
- (define-key map (kbd "C-c !") #'mastodon-toot-clear-all-attachments)
- (define-key map (kbd "C-c C-p") #'mastodon-toot-create-poll)
- (define-key map (kbd "C-c C-o") #'mastodon-toot-clear-poll)
- (define-key map (kbd "C-c C-l") #'mastodon-toot-set-toot-language)
- (define-key map (kbd "C-c C-s") #'mastodon-toot-schedule-toot)
- map)
- "Keymap for `mastodon-toot'.")
-
-(defun mastodon-toot-set-default-visibility ()
- "Set the default visibility for toots on the server."
- (interactive)
- (let ((vis (completing-read "Set default visibility to:"
- mastodon-toot-visibility-list
- nil t)))
- (mastodon-profile--update-preference "privacy" vis :source)))
-
-(defun mastodon-toot--get-max-toot-chars (&optional no-toot)
- "Fetch max_toot_chars from `mastodon-instance-url' asynchronously.
-NO-TOOT means we are not calling from a toot buffer."
- (mastodon-http--get-json-async
- (mastodon-http--api "instance")
- nil
- 'mastodon-toot--get-max-toot-chars-callback no-toot))
-
-(defun mastodon-toot--get-max-toot-chars-callback (json-response
- &optional no-toot)
- "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer.
-NO-TOOT means we are not calling from a toot buffer."
- (let ((max-chars
- (or (alist-get 'max_toot_chars json-response)
- (alist-get 'max_characters ; some servers have this instead
- (alist-get 'statuses
- (alist-get 'configuration
- json-response))))))
- (setq mastodon-toot--max-toot-chars max-chars)
- (unless no-toot
- (with-current-buffer "*new toot*"
- (mastodon-toot--update-status-fields)))))
-
-(defun mastodon-toot--action-success (marker byline-region remove &optional json)
- "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.
-JSON is added to the string as its item-json."
- (let ((inhibit-read-only t)
- (bol (car byline-region))
- (eol (cdr byline-region))
- (at-byline-p (eq t (mastodon-tl--property 'byline :no-move))))
- (save-excursion
- (when remove
- (goto-char bol)
- (beginning-of-line) ;; The marker is not part of the byline
- (if (search-forward (format "(%s) " marker) eol :no-error)
- (replace-match "")
- (user-error "Oops: could not find marker '(%s)'" marker)))
- (unless remove
- (goto-char bol)
- (insert
- (propertize
- (format "(%s) "
- (propertize marker
- 'face 'success))
- 'cursor-face 'mastodon-cursor-highlight-face
- 'item-json json)))) ;; for (un)folding items
- (when at-byline-p
- ;; leave point after the marker:
- (unless remove
- ;; if point is inside the byline, back up first so
- ;; we don't move to the following toot:
- (beginning-of-line)
- (forward-line -1)
- (mastodon-tl-goto-next-item)))))
-
-(defun mastodon-toot--action (action callback)
- "Take ACTION, a string, on toot at point, then execute CALLBACK.
-Makes a POST request to the server. Used for favouriting,
-boosting, or bookmarking toots."
- (let* ((id (mastodon-tl--property 'base-item-id))
- (url (mastodon-http--api
- (concat "statuses/" (mastodon-tl--as-string id) "/" action)))
- (response (mastodon-http--post url)))
- (mastodon-http--triage response callback)))
-
-(defun mastodon-toot--toggle-boost-or-favourite (action)
- "Toggle boost or favourite of toot at point.
-ACTION is a symbol, either `favourite' or `boost.'"
- (mastodon-toot--with-toot-item
- (let* ((n-type (mastodon-tl--property 'notification-type :no-move))
- (byline-region (mastodon-tl--find-property-range 'byline (point)))
- (boost-p (eq action 'boost))
- (action-str (symbol-name action))
- (item-json (mastodon-tl--property 'item-json))
- (vis (mastodon-tl--field 'visibility item-json)))
- (cond
- ((not byline-region)
- (user-error "Nothing to %s here?!?" action-str))
- ;; there's nothing wrong with faving/boosting own toots
- ;; & nothing wrong with faving/boosting own toots from notifs,
- ;; it boosts/faves the base toot, not the notif status
- ((or (string= n-type "follow")
- (string= n-type "follow_request"))
- (user-error "Can't %s %s notifications" action n-type))
- ((and boost-p
- (or (string= vis "direct")
- (string= vis "private")))
- (user-error "Can't boost posts with visibility: %s" vis))
- (t
- (let* ((boosted (when byline-region
- (get-text-property (car byline-region) 'boosted-p)))
- (faved (when byline-region
- (get-text-property (car byline-region) 'favourited-p)))
- (str-api (if boost-p "reblog" action-str))
- (action-str-api (mastodon-toot--str-negify str-api faved boosted
- action))
- (action-pp (concat
- (mastodon-toot--str-negify action-str faved boosted
- action)
- (if boost-p "ed" "d")))
- (remove-p (if boost-p boosted faved)))
- (mastodon-toot--action
- action-str-api
- (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 action remove-p)
- (mastodon-toot--action-success (mastodon-tl--symbol action)
- byline-region remove-p item-json))
- (message "%s #%s" action-pp id)))))))))
-
-(defun mastodon-toot--str-negify (str faved boosted action)
- "Add \"un\" to STR if item is already FAVED or BOOSTED.
-ACTION is the action currently being taken."
- (if (eq action 'boost)
- (if boosted (concat "un" str) str)
- (if faved
- (concat "un" str)
- str)))
-
-(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."
- (if (not (symbolp action))
- (error "Invalid argument: symbolp %s" action)
- (let* ((count-prop (if (eq action 'favourite)
- 'favourites-count
- 'boosts-count))
- (count-range (mastodon-tl--find-property-range count-prop (point)))
- (count (get-text-property (car count-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-range)
- (cdr count-range)
- (list 'display
- (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'."
- (interactive)
- (mastodon-toot--toggle-boost-or-favourite 'boost))
-
-(defun mastodon-toot-toggle-favourite ()
- "Favourite/unfavourite toot at `point'."
- (interactive)
- (mastodon-toot--toggle-boost-or-favourite 'favourite))
-
-;; TODO maybe refactor into boost/fave fun
-(defun mastodon-toot-toggle-bookmark ()
- "Bookmark or unbookmark toot at point."
- (interactive)
- (mastodon-toot--with-toot-item
- (let* ((n-type (mastodon-tl--property 'notification-type :no-move))
- (byline-region (mastodon-tl--find-property-range 'byline (point)))
- (bookmarked-p (when byline-region
- (get-text-property (car byline-region) 'bookmarked-p)))
- (action (if bookmarked-p "unbookmark" "bookmark")))
- (cond ((or (string= n-type "follow")
- (string= n-type "follow_request"))
- (user-error "Can't bookmark %s notifications" n-type))
- ((not byline-region)
- (user-error "Nothing to %s here?!?" action))
- (t
- (let* ((bookmark-str (mastodon-tl--symbol 'bookmark))
- (message (if bookmarked-p
- "Bookmark removed!"
- "Toot bookmarked!"))
- (item-json (mastodon-tl--property 'item-json)))
- (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 bookmarked-p item-json)
- (message "%s #%s" message id))))))))))
-
-(defun mastodon-toot-list-boosters ()
- "List the boosters of toot at point."
- (interactive)
- ;; use grouped notifs data if present:
- ;; only send accounts as arg if type matches notif type we are acting
- ;; on, to prevent showing accounts for a boost notif when asking for
- ;; favers, and vice versa.
- (let* ((type (mastodon-tl--property 'notification-type :no-move))
- (accounts (when (string= type "reblog")
- (mastodon-tl--property 'notification-accounts :no-move))))
- (mastodon-toot--list-boosters-or-favers nil accounts)))
-
-(defun mastodon-toot-list-favouriters ()
- "List the favouriters of toot at point."
- (interactive)
- (let* ((type (mastodon-tl--property 'notification-type :no-move))
- (accounts (when (string= type "favourite")
- (mastodon-tl--property 'notification-accounts :no-move))))
- (mastodon-toot--list-boosters-or-favers :favourite accounts)))
-
-(defun mastodon-toot--list-boosters-or-favers (&optional favourite accounts)
- "List the favouriters or boosters of toot at point.
-With FAVOURITE, list favouriters, else list boosters.
-ACCOUNTS is notfications accounts if any."
- (mastodon-toot--with-toot-item
- (let* ((endpoint (unless accounts
- (if favourite "favourited_by" "reblogged_by")))
- (url (unless accounts
- (mastodon-http--api (format "statuses/%s/%s" id endpoint))))
- (params (unless accounts '(("limit" . "80"))))
- (json (or accounts (mastodon-http--get-json url params))))
- (if (eq (caar json) 'error)
- (user-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)
- (user-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.
-If the toot is a fave/boost notification, copy the URL of the
-base toot."
- (interactive)
- (let* ((url (mastodon-toot--toot-url)))
- (kill-new url)
- (message "Toot URL copied to the clipboard.")))
-
-(defun mastodon-toot-browse-toot-url ()
- "Browse URL of toot at point.
-Calls `browse-url'."
- (interactive)
- (browse-url
- (mastodon-toot--toot-url)))
-
-(defun mastodon-toot--toot-url ()
- "Return the URL of the base toot at point."
- (let* ((toot (mastodon-toot--base-toot-or-item-json)))
- (if (mastodon-tl--field 'reblog toot)
- (alist-get 'url (alist-get 'reblog toot))
- (alist-get 'url toot))))
-
-(defun mastodon-toot-copy-toot-text ()
- "Copy text of toot at point.
-If the toot is a fave/boost notification, copy the text of the
-base toot."
- (interactive)
- (let* ((toot (mastodon-toot--base-toot-or-item-json)))
- (kill-new (mastodon-tl--content toot))
- (message "Toot content copied to the clipboard.")))
-
-(defun mastodon-toot-translate-toot-text ()
- "Translate text of toot at point.
-Uses `lingva.el'."
- (interactive)
- (if mastodon-tl--buffer-spec
- (if-let* ((toot (mastodon-tl--property 'item-json)))
- (condition-case x
- (lingva-translate nil
- (mastodon-tl--content toot)
- (when mastodon-tl--enable-proportional-fonts
- t))
- (void-function
- (user-error "Looks like you need to install lingva.el. Error: %s"
- (error-message-string x))))
- (user-error "No toot to translate?"))
- (user-error "No mastodon buffer?")))
-
-(defun mastodon-toot--own-toot-p (toot)
- "Check if TOOT is user's own, for deleting, editing, or pinning it."
- ;; this check needs to allow acting on own toots displayed as boosts, so we
- ;; call `mastodon-tl--toot-or-base'.
- (let ((json (mastodon-tl--toot-or-base toot)))
- (string= (alist-get 'acct (alist-get 'account json))
- (mastodon-auth--user-acct))))
-
-(defun mastodon-toot-pin-toot-toggle ()
- "Pin or unpin user's toot at point."
- (interactive)
- (let* ((toot (mastodon-toot--base-toot-or-item-json))
- (pinnable-p (mastodon-toot--own-toot-p toot))
- (pinned-p (eq t (alist-get 'pinned toot)))
- (action (if pinned-p "unpin" "pin"))
- (msg (if pinned-p "unpinned" "pinned")))
- (if (not pinnable-p)
- (user-error "You can only pin your own toots")
- (when (y-or-n-p (format "%s this toot? " (capitalize action)))
- (mastodon-toot--action
- action
- (lambda (_)
- ;; let's only reload when in own profile view:
- (when (mastodon-tl--own-profile-buffer-p)
- (mastodon-tl--reload-timeline-or-profile))
- (message "Toot %s!" msg)))))))
-
-\f
-;;; DELETE, DRAFT, REDRAFT
-
-(defun mastodon-toot-delete-toot ()
- "Delete user's toot at point synchronously."
- (interactive)
- (mastodon-toot-delete-and-redraft-toot t))
-
-;; TODO: handle media/poll for redrafting toots
-(defun mastodon-toot-delete-and-redraft-toot (&optional no-redraft)
- "Delete and redraft user's toot at point synchronously.
-NO-REDRAFT means delete toot only."
- (interactive)
- (let* ((toot (mastodon-toot--base-toot-or-item-json))
- (id (mastodon-tl--as-string (mastodon-tl--item-id toot)))
- (url (mastodon-http--api (format "statuses/%s" id)))
- (pos (point)))
- (let-alist toot
- (if (not (mastodon-toot--own-toot-p toot))
- (user-error "You can only delete (and redraft) your own toots")
- (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 pos))
- (message "Toot deleted!"))
- (mastodon-toot--redraft response
- .in_reply_to_id
- .visibility
- .spoiler_text))))))))))
-
-(defun mastodon-toot--set-cw (&optional cw)
- "Set content warning to CW if it is non-nil."
- (unless (or (null cw) ; cw is nil for `mastodon-tl-dm-user'
- (string-empty-p cw))
- (setq mastodon-toot--content-warning cw)))
-
-\f
-;;; REDRAFT
-
-(defun mastodon-toot--redraft (response &optional reply-id toot-visibility
- toot-cw)
- "Opens a new toot compose buffer using values from RESPONSE buffer.
-REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved."
- (with-current-buffer response
- (let* ((response (mastodon-http--process-json))
- (content (alist-get 'text response)))
- (mastodon-toot--compose-buffer)
- (goto-char (point-max))
- (insert content)
- ;; adopt reply-to-id, visibility and CW from deleted toot:
- (mastodon-toot--set-toot-properties
- reply-id toot-visibility toot-cw
- ;; TODO set new lang/scheduled props here
- nil))))
-
-(defun mastodon-toot--set-toot-media-attachments (media)
- "Set the media attachments variables.
-MEDIA is the media_attachments data for a status from the server."
- (mapcar (lambda (x)
- (cl-pushnew (alist-get 'id x)
- mastodon-toot--media-attachment-ids)
- (cl-pushnew `((:contents . ,(mastodon-http--read-file-as-string
- (alist-get 'url x) :url))
- (:description . ,(alist-get 'description x)))
- mastodon-toot--media-attachments))
- media))
-
-(defun mastodon-toot--set-toot-properties
- (reply-id visibility cw lang &optional scheduled scheduled-id media poll)
- "Set the toot properties for the current redrafted or edited toot.
-REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set.
-MEDIA is the media_attachments data for a status from the server."
- (with-current-buffer "*edit toot*"
- (when reply-id
- (setq mastodon-toot--reply-to-id reply-id))
- (setq mastodon-toot--visibility visibility)
- (setq mastodon-toot--scheduled-for scheduled)
- (setq mastodon-toot--scheduled-id scheduled-id)
- (when (not (string-empty-p lang))
- (setq mastodon-toot--language lang))
- (mastodon-toot--set-cw cw)
- (when media
- (mastodon-toot--set-toot-media-attachments media))
- (when poll
- (mastodon-toot--server-poll-to-local poll))
- (mastodon-toot--refresh-attachments-display)
- (mastodon-toot--update-status-fields)))
-
-(defun mastodon-toot--kill (&optional cancel)
- "Kill `mastodon-toot-mode' buffer and window.
-CANCEL means the toot was not sent, so we save the toot text as a draft."
- (let ((prev-window-config mastodon-toot-previous-window-config))
- (unless (eq mastodon-toot-current-toot-text nil)
- (when cancel
- (cl-pushnew mastodon-toot-current-toot-text
- mastodon-toot-draft-toots-list :test #'string=)))
- ;; prevent some weird bug when cancelling a non-empty toot:
- (delete #'mastodon-toot--save-toot-text after-change-functions)
- (quit-window 'kill)
- (mastodon-toot--restore-previous-window-config prev-window-config)))
-
-(defun mastodon-toot-cancel ()
- "Kill new-toot buffer/window. Does not POST content.
-If toot is not empty, prompt to save text as a draft."
- (interactive)
- (when (and (not (mastodon-toot--empty-p))
- (y-or-n-p "Save draft toot?"))
- (mastodon-toot-save-draft))
- (mastodon-toot--kill))
-
-(defun mastodon-toot-save-draft ()
- "Save the current compose toot text as a draft.
-Pushes `mastodon-toot-current-toot-text' to
-`mastodon-toot-draft-toots-list'."
- (interactive)
- (unless (string= mastodon-toot-current-toot-text nil)
- (cl-pushnew mastodon-toot-current-toot-text
- mastodon-toot-draft-toots-list :test 'string=)
- (message "Draft saved!")))
-
-(defun mastodon-toot--empty-p (&optional text-only)
- "Return t if toot has no text, attachments, or polls.
-TEXT-ONLY means don't check for attachments or polls."
- (and (if text-only
- t
- (and (not mastodon-toot--media-attachments)
- (not mastodon-toot-poll)))
- (string-empty-p (mastodon-tl--clean-tabs-and-nl
- (mastodon-toot--remove-docs)))))
-
-\f
-;;; EMOJIS
-
-(defun mastodon-toot-insert-emoji ()
- "Prompt to insert an emoji."
- (interactive)
- (if mastodon-use-emojify
- (emojify-insert-emoji)
- (call-interactively #'emoji-search))) ;; 29.1
-
-(defun mastodon-toot--emoji-dir ()
- "Return the file path for the mastodon custom emojis directory."
- (concat (expand-file-name emojify-emojis-dir)
- "/mastodon-custom-emojis/"))
-
-(defun mastodon-toot-download-custom-emoji ()
- "Download `mastodon-instance-url's custom emoji.
-Emoji images are stored in a subdir of `emojify-emojis-dir'.
-To use the downloaded emoji, run `mastodon-toot-enable-custom-emoji'."
- (interactive)
- (let* ((url (mastodon-http--api "custom_emojis"))
- (custom-emoji (mastodon-http--get-json url))
- (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir)))
- (if (not (file-directory-p emojify-emojis-dir))
- (user-error "Looks like you need to set up emojify first")
- (unless (file-directory-p mastodon-custom-emoji-dir)
- (make-directory mastodon-custom-emoji-dir nil)) ; no add parent
- (cl-loop for x in custom-emoji
- do (let ((url (alist-get 'url x))
- (shortcode (alist-get 'shortcode x)))
- ;; skip anything that contains unexpected characters
- (when (and url shortcode
- (string-match-p "^[a-zA-Z0-9-_]+$" shortcode)
- (string-match-p "^[a-zA-Z]+$" (file-name-extension url)))
- (url-copy-file url
- (concat mastodon-custom-emoji-dir
- shortcode
- "."
- (file-name-extension url))
- t))))
- (message "Custom emoji for %s downloaded to %s"
- mastodon-instance-url
- mastodon-custom-emoji-dir))))
-
-(defun mastodon-toot--collect-custom-emoji ()
- "Return a list of `mastodon-instance-url's custom emoji.
-The list is formatted for `emojify-user-emojis', which see."
- (let* ((mastodon-custom-emojis-dir (mastodon-toot--emoji-dir))
- (custom-emoji-files (directory-files mastodon-custom-emojis-dir
- nil ; not full path
- "^[^.]")) ; no dot files
- mastodon-emojify-user-emojis)
- (cl-loop for x in custom-emoji-files
- do (push
- `(,(concat ":"
- (file-name-base x) ":")
- . (("name" . ,(file-name-base x))
- ("image" . ,(concat mastodon-custom-emojis-dir x))
- ("style" . "github")))
- mastodon-emojify-user-emojis))
- (reverse mastodon-emojify-user-emojis)))
-
-(defun mastodon-toot-enable-custom-emoji ()
- "Add `mastodon-instance-url's custom emoji to `emojify'.
-Custom emoji must first be downloaded with
-`mastodon-toot-download-custom-emoji'. Custom emoji are appended
-to `emojify-user-emojis', and the emoji data is updated."
- (interactive)
- (unless (file-exists-p (mastodon-toot--emoji-dir))
- (when (y-or-n-p "Looks like you haven't downloaded your
- instance's custom emoji yet. Download now? ")
- (mastodon-toot-download-custom-emoji)))
- (let ((masto-emojis (mastodon-toot--collect-custom-emoji)))
- (unless (cl-find (car masto-emojis)
- emojify-user-emojis
- :test #'equal)
- (setq emojify-user-emojis
- (append masto-emojis
- emojify-user-emojis))
- ;; if already loaded, reload
- (when (featurep 'emojify)
- ;; we now only do this within the unless test above, as it is extremely
- ;; slow and runs in `mastodon-mode-hook'.
- (emojify-set-emoji-data)))))
-
-(defun mastodon-toot--remove-docs ()
- "Get the body of a toot from the current compose buffer."
- (let ((header-region (mastodon-tl--find-property-range 'toot-post-header
- (point-min))))
- (string-trim-left
- (buffer-substring (cdr header-region) (point-max)))))
-
-(defun mastodon-toot--build-poll-params ()
- "Return an alist of parameters for POSTing a poll status."
- (if mastodon-toot-poll-use-transient
- (let-alist mastodon-toot-poll
- (append
- (mastodon-http--build-array-params-alist
- "poll[options][]"
- (list .one .two .three .four))
- (list (cons "poll[expires_in]" .expiry)
- (cons "poll[multiple]" .multi)
- (cons "poll[hide_totals]" .hide))))
- (append
- (mastodon-http--build-array-params-alist
- "poll[options][]"
- (plist-get mastodon-toot-poll :options))
- `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry)))
- `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
- `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))))
-
-\f
-;;; SEND TOOT FUNCTION
-
-(defun mastodon-toot-send ()
- "POST contents of new-toot buffer to fediverse instance and kill buffer.
-If media items have been attached and uploaded with
-`mastodon-toot-attach-media', they are attached to the toot.
-If `mastodon-toot--edit-item-id' is non-nil, PUT contents to
-instance to edit a toot."
- (interactive)
- (let* ((toot (mastodon-toot--remove-docs))
- (scheduled mastodon-toot--scheduled-for)
- (scheduled-id mastodon-toot--scheduled-id)
- (edit-id mastodon-toot--edit-item-id)
- (endpoint (mastodon-http--api (if edit-id ; we are sending an edit:
- (format "statuses/%s" edit-id)
- "statuses")))
- (args-no-media
- (append
- `(("status" . ,toot)
- ("in_reply_to_id" . ,mastodon-toot--reply-to-id)
- ("visibility" . ,mastodon-toot--visibility)
- ("sensitive" . ,(when mastodon-toot--content-nsfw
- (symbol-name t)))
- ("spoiler_text" . ,mastodon-toot--content-warning)
- ("language" . ,mastodon-toot--language))
- ;; Pleroma instances can't handle null-valued
- ;; scheduled_at args, so only add if non-nil
- (when scheduled `(("scheduled_at" . ,scheduled)))))
- (args-media (when mastodon-toot--media-attachment-ids
- (mastodon-http--build-array-params-alist
- "media_ids[]"
- mastodon-toot--media-attachment-ids)))
- (args-poll (when mastodon-toot-poll
- (mastodon-toot--build-poll-params)))
- ;; media || polls:
- (args (if mastodon-toot--media-attachment-ids
- (append args-media args-no-media)
- (if mastodon-toot-poll
- (append args-no-media args-poll)
- args-no-media)))
- (prev-window-config mastodon-toot-previous-window-config))
- (cond ((and mastodon-toot--media-attachment-ids
- ;; make sure we have media args
- ;; and the same num of ids as attachments
- (or (not args-media)
- (not (= (length mastodon-toot--media-attachments)
- (length mastodon-toot--media-attachment-ids)))))
- (user-error "Something is wrong with your uploads. Wait for them to complete or try again"))
- ((and mastodon-toot--max-toot-chars
- (> (mastodon-toot--count-toot-chars toot mastodon-toot--content-warning)
- mastodon-toot--max-toot-chars))
- (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length"))
- ;; polls must have text, so we use poll as flag for text-only
- ;; check here:
- ((mastodon-toot--empty-p mastodon-toot-poll)
- (user-error "Empty toot. Cowardly refusing to post this"))
- (t
- (let ((response (funcall (if edit-id ; we are sending an edit:
- #'mastodon-http--put
- #'mastodon-http--post)
- endpoint args)))
- (mastodon-http--triage
- response
- (lambda (_)
- ;; kill buffer:
- (mastodon-toot--kill)
- ;; nil our poll var:
- (setq mastodon-toot-poll nil)
- (message "Toot %s!" (if scheduled "scheduled" "toot"))
- ;; cancel scheduled toot if we were editing it:
- (when scheduled-id
- (mastodon-views-cancel-scheduled-toot
- scheduled-id :no-confirm))
- ;; window config:
- (mastodon-toot--restore-previous-window-config prev-window-config)
- ;; reload: - when we have been editing
- ;; - when we are in thread view
- ;; (we don't reload in every case as it can be slow and we
- ;; may lose our place in a timeline.)
- (let ((type (mastodon-tl--get-buffer-type)))
- (when (or edit-id
- (eq 'single-status type)
- (eq 'thread type))
- (let ((pos (marker-position (cadr prev-window-config))))
- (mastodon-tl--reload-timeline-or-profile pos)))))))))))
-
-\f
-;;; EDITING TOOTS:
-
-(defun mastodon-toot-edit-toot-at-point ()
- "Edit the user's toot at point."
- (interactive)
- (mastodon-toot--with-toot-item
- (let ((toot (mastodon-toot--base-toot-or-item-json)))
- (if (not (mastodon-toot--own-toot-p toot))
- (user-error "You can only edit your own toots")
- (let* ((source (mastodon-toot--get-toot-source id))
- (content (alist-get 'text source))
- (source-cw (alist-get 'spoiler_text source)))
- (let-alist toot
- (when (y-or-n-p "Edit this toot? ")
- (mastodon-toot--compose-buffer nil .in_reply_to_id nil
- content :edit)
- (goto-char (point-max))
- ;; adopt reply-to-id, visibility, CW, language, and media:
- (mastodon-toot--set-toot-properties .in_reply_to_id .visibility
- source-cw .language nil nil
- ;; maintain media order:
- (reverse .media_attachments) .poll)
- (setq mastodon-toot--edit-item-id id))))))))
-
-(defun mastodon-toot--get-toot-source (id)
- "Fetch the source JSON of toot with ID."
- (let ((url (mastodon-http--api (format "/statuses/%s/source" id))))
- (mastodon-http--get-json url nil :silent)))
-
-(defun mastodon-toot--get-toot-edits (id)
- "Return the edit history of toot with ID."
- (let* ((url (mastodon-http--api (format "statuses/%s/history" id))))
- (mastodon-http--get-json url)))
-
-(defun mastodon-toot-view-toot-edits ()
- "View editing history of the toot at point in a popup buffer."
- (interactive)
- (let ((id (mastodon-tl--property 'base-item-id))
- (history (mastodon-tl--property 'edit-history)) ;; at byline
- (buf "*mastodon-toot-edits*"))
- (if (not history)
- (user-error "No editing history for this toot")
- (with-mastodon-buffer buf #'special-mode :other-window
- (cl-loop for count from 1
- for x in history
- do (insert (propertize (if (= count 1)
- (format "%s [original]:\n" count)
- (format "%s:\n" count))
- 'face 'mastodon-toot-docs-face)
- (mastodon-toot--insert-toot-iter x)
- "\n"))
- (goto-char (point-min))
- (setq-local header-line-format
- (propertize
- (format "Edits to toot by %s:"
- (alist-get 'username
- (alist-get 'account (car history))))
- 'face 'mastodon-toot-docs-face))
- (mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
- (format "statuses/%s/history" id)
- nil)))))
-
-(defun mastodon-toot--insert-toot-iter (it)
- "Insert iteration IT of toot."
- (let ((content (alist-get 'content it)))
- ;; TODO: handle polls, media
- (mastodon-tl--render-text content)))
-
-(defun mastodon-toot--restore-previous-window-config (config)
- "Restore the window CONFIG after killing the toot compose buffer.
-Buffer-local variable `mastodon-toot-previous-window-config' holds the config."
- (set-window-configuration (car config))
- (goto-char (cadr config)))
-
-(defun mastodon-toot--mentions-to-string (mentions)
- "Apply `mastodon-toot--process-local' function to each mention in MENTIONS.
-Remove empty string (self) from result and joins the sequence with whitespace."
- (let ((mentions (remove ""
- (mapcar #'mastodon-toot--process-local mentions))))
- (mapconcat #'identity mentions " ")))
-
-(defun mastodon-toot--process-local (acct)
- "Add domain to local ACCT and replace the curent user name with \"\".
-Mastodon requires the full @user@domain, even in the case of local accts.
-eg. \"user\" -> \"@userNOSPAMlocal.social\" (when local.social is the domain of the
-`mastodon-instance-url').
-eg. \"yourusername\" -> \"\"
-eg. \"feduserNOSPAMfed.social\" -> \"@feduserNOSPAMfed.social\"."
- (cond ((string-match-p "@" acct) (concat "@" acct)) ; federated acct
- ((string= (mastodon-auth--user-acct) acct) "") ; your acct
- (t
- (concat "@" acct "@" ; local acct
- (cadr
- (split-string mastodon-instance-url "/" :omit-nulls))))))
-
-\f
-;;; COMPLETION (TAGS, MENTIONS)
-
-(defun mastodon-toot--mentions (status)
- "Extract mentions (not the reply-to author or booster) from STATUS.
-The mentioned users look like this:
-Local user (including the logged in): `username`.
-Federated user: `usernameNOSPAMhost.co`."
- (let* ((mentions (mastodon-tl--field 'mentions status)))
- ;; reverse does not work on vectors in 24.5
- (mastodon-tl--map-alist 'acct (reverse mentions))))
-
-(defun mastodon-toot--get-bounds (regex)
- "Get bounds of tag or handle before point using REGEX."
- ;; # and @ are not part of any existing thing at point
- (save-match-data
- (save-excursion
- ;; match full handle inc. domain, or tag including #
- ;; (see the regexes for subexp 2)
- (when (re-search-backward regex
- (save-excursion (forward-whitespace -1)
- (point))
- :no-error)
- (cons (match-beginning 2)
- (match-end 2))))))
-
-(defun mastodon-toot--fetch-emojify-candidates ()
- "Get the candidates to be used for emojis completion.
-The candidates are calculated according to currently active
-`emojify-emoji-styles'. Hacked off
-`emojify--get-completing-read-candidates'."
- (let ((styles (mapcar #'symbol-name emojify-emoji-styles)))
- (let ((emojis '()))
- (emojify-emojis-each
- (lambda (key value)
- (when (seq-position styles (ht-get value "style"))
- (push (cons key
- (format "%s (%s)"
- (ht-get value "name")
- (ht-get value "style")))
- emojis))))
- emojis)))
-
-(defun mastodon-toot--fetch-candidates (start end &optional type)
- "Search for a completion prefix from buffer positions START to END.
-Return a list of candidates.
-TYPE is the candidate type, it may be :tags, :handles, or :emoji."
- ;; we can't save the first two-letter search then only filter the
- ;; resulting list, as max results returned is 40.
- (setq mastodon-toot-completions
- (cond ((eq type :tags)
- (let ((tags-list (mastodon-search--search-tags-query
- (buffer-substring-no-properties start end))))
- (cl-loop for tag in tags-list
- collect (cons (concat "#" (car tag))
- (cdr tag)))))
- ((eq type :emoji)
- (when (bound-and-true-p emojify-mode)
- (mastodon-toot--fetch-emojify-candidates)))
- (t
- (mastodon-search--search-accounts-query
- (buffer-substring-no-properties start end))))))
-
-(defun mastodon-toot--make-capf (regex annot-fun type)
- "Build a completion backend for `completion-at-point-functions'.
-REGEX is the regex to match preceding text.
-TYPE is a keyword symbol for `mastodon-toot--fetch-candidates'.
-ANNOT-FUN is a function returning an annotatation from a single
-arg, a candidate."
- (let* ((bounds (mastodon-toot--get-bounds regex))
- (start (car bounds))
- (end (cdr bounds)))
- (when bounds
- (list start
- end
- (completion-table-dynamic ; only search when necessary
- (lambda (_)
- ;; Interruptible candidate computation, from minad/d mendler, thanks!
- (let ((result
- (while-no-input
- (mastodon-toot--fetch-candidates
- start end type))))
- (and (consp result) result))))
- :exclusive 'no
- :annotation-function
- (lambda (cand)
- (concat " " (funcall annot-fun cand)))))))
-
-(defun mastodon-toot--mentions-capf ()
- "Build a mentions completion backend for `completion-at-point-functions'."
- (mastodon-toot--make-capf mastodon-toot-handle-regex
- #'mastodon-toot--mentions-annotation-fun
- :handles))
-
-(defun mastodon-toot--tags-capf ()
- "Build a tags completion backend for `completion-at-point-functions'."
- (mastodon-toot--make-capf mastodon-toot-tag-regex
- #'mastodon-toot--tags-annotation-fun
- :tags))
-
-(defun mastodon-toot--emoji-capf ()
- "Build an emoji completion backend for `completion-at-point-functions'."
- (mastodon-toot--make-capf mastodon-toot-emoji-regex
- #'mastodon-toot--emoji-annotation-fun
- :emoji))
-
-(defun mastodon-toot--mentions-annotation-fun (candidate)
- "Given a handle completion CANDIDATE, return its annotation string, a username."
- (caddr (assoc candidate mastodon-toot-completions)))
-
-(defun mastodon-toot--tags-annotation-fun (candidate)
- "Given a tag string CANDIDATE, return an annotation, the tag's URL."
- ;; TODO: check the list returned here? should be cadr
- ;; or make it an alist and use cdr
- (cadr (assoc candidate mastodon-toot-completions)))
-
-(defun mastodon-toot--emoji-annotation-fun (candidate)
- "CANDIDATE."
- ;; TODO: emoji image as annot
- (cdr (assoc candidate mastodon-toot-completions)))
-
-\f
-;;; REPLY
-
-(defun mastodon-toot-reply ()
- "Reply to toot at `point'.
-Customize `mastodon-toot-display-orig-in-reply-buffer' to display
-text of the toot being replied to in the compose buffer.
-If the region is active, inject it into the reply buffer,
-prefixed by >."
- (interactive)
- (mastodon-toot--with-toot-item
- (let* ((quote (when (region-active-p)
- (buffer-substring (region-beginning)
- (region-end))))
- (toot (mastodon-toot--base-toot-or-item-json))
- (account (mastodon-tl--field 'account toot))
- (user (alist-get 'acct account))
- (mentions (mastodon-toot--mentions toot))
- (boosted (mastodon-tl--field 'reblog toot))
- (booster (when boosted
- (alist-get 'acct
- (alist-get 'account toot))))
- (mentions
- (cond ((and booster ;; different booster, user and mentions:
- (and (not (string= user booster))
- (not (member booster mentions))))
- (mastodon-toot--mentions-to-string
- (append (list user booster) mentions nil)))
- ((not (member user mentions)) ;; user not in mentions:
- (mastodon-toot--mentions-to-string
- (append (list user) mentions nil)))
- (t ;; user already in mentions:
- (mastodon-toot--mentions-to-string
- (copy-sequence mentions))))))
- (mastodon-toot--compose-buffer mentions id toot quote))))
-
-\f
-;;; COMPOSE TOOT SETTINGS
-
-(defun mastodon-toot-set-content-warning ()
- "Set a content warning for the current toot."
- (interactive)
- (setq mastodon-toot--content-warning
- (read-string "Warning: " mastodon-toot--content-warning))
- (mastodon-toot--update-status-fields))
-
-(defun mastodon-toot-toggle-nsfw ()
- "Toggle `mastodon-toot--content-nsfw'."
- (interactive)
- (setq mastodon-toot--content-nsfw
- (not mastodon-toot--content-nsfw))
- (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off"))
- (mastodon-toot--update-status-fields))
-
-(defun mastodon-toot-change-visibility (&optional arg)
- "Change the current visibility to the next valid value.
-With prefix ARG, read a visibility type in the minibuffer."
- (interactive "P")
- (if (mastodon-tl--buffer-type-eq 'edit-toot)
- (user-error "You can't change visibility when editing toots")
- (setq mastodon-toot--visibility
- (if arg
- (completing-read "Visibility: "
- mastodon-toot-visibility-list)
- (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-set-toot-language ()
- "Prompt for a language and set `mastodon-toot--language'.
-Return its two letter ISO 639 1 code."
- (interactive)
- (let* ((choice (completing-read "Language for this toot: "
- mastodon-iso-639-1)))
- (setq mastodon-toot--language
- (alist-get choice mastodon-iso-639-1 nil nil #'string=))
- (message "Language set to %s" choice)
- (mastodon-toot--update-status-fields)))
-
-\f
-;;; ATTACHMENTS
-
-(defun mastodon-toot-clear-all-attachments ()
- "Remove all attachments from a toot draft."
- (interactive)
- (setq mastodon-toot--media-attachments nil)
- (setq mastodon-toot--media-attachment-ids nil)
- (mastodon-toot--refresh-attachments-display)
- (mastodon-toot--update-status-fields))
-
-(defun mastodon-toot--get-instance-max-attachments ()
- "Return the maximum attachments from `mastodon-active-user's instance.
-If that fails, return 4 as a fallback"
- ;; FIXME: this likely various for other server types:
- ;; pleroma doesn't advertise this on "api/v1/instance" (checked
- ;; fe.disroot.org)
- (or
- (let ((config (alist-get 'statuses
- (alist-get 'configuration
- (mastodon-views--get-own-instance)))))
- (alist-get 'max_media_attachments config))
- 4)) ; mastodon default as fallback
-
-(defun mastodon-toot-attach-media (file description)
- "Prompt for an attachment FILE with DESCRIPTION.
-A preview is displayed in the new toot buffer, and the file
-is uploaded asynchronously using `mastodon-toot--upload-attached-media'.
-File is actually attached to the toot upon posting."
- (interactive "fFilename: \nsDescription: ")
- (let ((max-attachments (mastodon-toot--get-instance-max-attachments)))
- (when (>= (length mastodon-toot--media-attachments)
- max-attachments)
- ;; warn + pop the oldest one:
- (when (y-or-n-p
- (format "Maximum attachments (%s) reached: remove first one?"
- max-attachments))
- (pop mastodon-toot--media-attachments)))
- (if (file-directory-p file)
- (user-error "Looks like you chose a directory not a file")
- (setq mastodon-toot--media-attachments
- (nconc mastodon-toot--media-attachments
- `(((:contents . ,(mastodon-http--read-file-as-string file))
- (:description . ,description)
- (:filename . ,file)))))
- (mastodon-toot--refresh-attachments-display)
- ;; upload only most recent attachment:
- (mastodon-toot--upload-attached-media
- (car (last mastodon-toot--media-attachments))))))
-
-(defun mastodon-toot--attachment-descriptions ()
- "Return a list of image descriptions for current attachments."
- (mastodon-tl--map-alist :description mastodon-toot--media-attachments))
-
-(defun mastodon-toot--attachment-from-desc (desc)
- "Return an attachment based on its description DESC."
- (car
- (cl-member-if (lambda (x)
- (rassoc desc x))
- mastodon-toot--media-attachments)))
-
-(defun mastodon-toot-edit-media-description ()
- "Prompt for an attachment, and update its description."
- (interactive)
- (let* ((descs (mastodon-toot--attachment-descriptions))
- (choice (completing-read "Attachment: " descs nil :match))
- (attachment (mastodon-toot--attachment-from-desc choice))
- (desc-new (read-string "Description: " choice)))
- (setf (alist-get :description attachment)
- desc-new)
- (mastodon-toot--refresh-attachments-display)))
-
-(defun mastodon-toot--upload-attached-media (attachment)
- "Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'.
-The item's id is added to `mastodon-toot--media-attachment-ids',
-which is used to attach it to a toot when posting."
- (let* ((filename (expand-file-name (alist-get :filename attachment)))
- (caption (alist-get :description attachment))
- (url (concat mastodon-instance-url "/api/v2/media")))
- (message "Uploading %s... (please wait before starting further uploads)"
- (file-name-nondirectory filename))
- (mastodon-http--post-media-attachment url filename caption)))
-
-(defun mastodon-toot--refresh-attachments-display ()
- "Update the display attachment previews in toot draft buffer."
- (let ((inhibit-read-only t)
- (attachments-region (mastodon-tl--find-property-range
- 'toot-attachments (point-min)))
- (display-specs (mastodon-toot--format-attachments)))
- (dotimes (i (- (cdr attachments-region) (car attachments-region)))
- (add-text-properties (+ i (car attachments-region))
- (+ i 1 (car attachments-region))
- (list 'display (or (nth i display-specs) ""))))))
-
-(defun mastodon-toot--format-attachments ()
- "Format the attachment previews for display in toot draft buffer."
- (or
- (let ((image-options (when (mastodon-tl--image-trans-check)
- `(:height ,mastodon-toot--attachment-height))))
- (cl-loop for count from 1
- for att in mastodon-toot--media-attachments
- nconc
- (let* ((data (alist-get :contents att))
- (image (apply #'create-image data
- (if (version< emacs-version "27.1")
- (when image-options 'imagemagick)
- nil) ; inbuilt scaling in 27.1
- t image-options))
- (desc (alist-get :description att)))
- (list (format "\n %d: " count)
- image
- (format " \"%s\"" desc)))))
- (list "None")))
-
-\f
-;;; POLL
-
-(defun mastodon-toot--fetch-max-poll-options (instance)
- "Return the maximum number of poll options from JSON data INSTANCE."
- (mastodon-toot--fetch-poll-field 'max_options instance))
-
-(defun mastodon-toot--fetch-max-poll-option-chars (instance)
- "Return the maximum number of characters a poll option may have.
-INSTANCE is JSON."
- (if (alist-get 'pleroma instance)
- (mastodon-toot--fetch-poll-field 'max_option_chars instance)
- (or (mastodon-toot--fetch-poll-field 'max_characters_per_option instance)
- 50))) ; masto default
-
-(defun mastodon-toot--fetch-poll-field (field instance)
- "Return FIELD from the poll settings from JSON data INSTANCE."
- (let* ((polls (if (alist-get 'pleroma instance)
- (alist-get 'poll_limits instance)
- (alist-get 'polls
- (alist-get 'configuration instance)))))
- (alist-get field polls)))
-
-(defun mastodon-toot--read-poll-options-count (max)
- "Read the user's choice of the number of options the poll should have.
-MAX is the maximum number set by their instance."
- (let ((number (read-number (format "Number of options [2-%s]: " max) 2)))
- (if (> number max)
- (user-error "You need to choose a number between 2 and %s" max)
- number)))
-
-(defun mastodon-toot-create-poll ()
- "Prompt for new poll options and return as a list."
- (interactive)
- (if mastodon-toot-poll-use-transient
- (call-interactively #'mastodon-create-poll)
- (mastodon-toot--read-poll)))
-
-(defun mastodon-toot--read-poll ()
- "Read poll options."
- (let* ((instance (mastodon-instance-data))
- (max-options (mastodon-toot--fetch-max-poll-options instance))
- (count (mastodon-toot--read-poll-options-count max-options))
- (length (mastodon-toot--fetch-max-poll-option-chars instance))
- (multiple-p (y-or-n-p "Multiple choice? "))
- (options (mastodon-toot--read-poll-options count length))
- (hide-totals (y-or-n-p "Hide votes until poll ends? "))
- (expiry (mastodon-toot--read-poll-expiry))
- (expiry-str (cdr expiry))
- (expiry-human (car expiry)))
- (setq mastodon-toot-poll
- `( :options ,options :length ,length :expiry-readable ,expiry-human
- :expiry ,expiry-str :multi ,multiple-p :hide ,hide-totals))
- (message "poll created!")
- (mastodon-toot--update-status-fields)))
-
-(defun mastodon-toot--read-poll-options (count length)
- "Read a list of options for poll with COUNT options.
-LENGTH is the maximum character length allowed for a poll option."
- (let* ((choices
- (cl-loop for x from 1 to count
- collect (read-string
- (format "Poll option [%s/%s] [max %s chars]: "
- x count length))))
- (longest (apply #'max (mapcar #'length choices))))
- (if (not (> longest length))
- choices
- (user-error "Looks like you went over the max length. Try again")
- (sleep-for 2)
- (mastodon-toot--read-poll-options count length))))
-
-(defun mastodon-toot--read-poll-expiry ()
- "Prompt for a poll expiry time.
-Return a cons of a human readable string, and a seconds-from-now string."
- ;; API requires this in seconds
- (let* ((options (mastodon-toot--poll-expiry-options-alist))
- (response (completing-read "poll ends in [or enter seconds]: "
- options nil 'confirm)))
- (or (assoc response options #'string=)
- (if (< (string-to-number response) 300)
- (cons "5 minutes" (number-to-string (* 60 5))) ;; min 5 mins
- (cons (format "%s seconds" response) response)))))
-
-(defun mastodon-toot--poll-expiry-options-alist ()
- "Return an alist of expiry options options in seconds."
- `(("5 minutes" . ,(number-to-string (* 60 5)))
- ("30 minutes" . ,(number-to-string (* 60 30)))
- ("1 hour" . ,(number-to-string (* 60 60)))
- ("6 hours" . ,(number-to-string (* 60 60 6)))
- ("1 day" . ,(number-to-string (* 60 60 24)))
- ("3 days" . ,(number-to-string (* 60 60 24 3)))
- ("7 days" . ,(number-to-string (* 60 60 24 7)))
- ("14 days" . ,(number-to-string (* 60 60 24 14)))
- ("30 days" . ,(number-to-string (* 60 60 24 30)))))
-
-(defun mastodon-toot-clear-poll (&optional transient)
- "Remove poll from toot compose buffer.
-Sets `mastodon-toot-poll' to nil.
-If TRANSIENT, we are called from a transient, so nil
-`tp-transient-settings' too."
- (interactive)
- (let ((var (if transient
- 'tp-transient-settings
- 'mastodon-toot-poll)))
- (if (not (symbol-value var))
- (user-error "No poll?")
- (set var nil)
- (when transient
- (setq mastodon-toot-poll nil))
- (mastodon-toot--update-status-fields))))
-
-(defun mastodon-toot--server-poll-to-local (json)
- "Convert server poll data JSON to a `mastodon-toot-poll' plist."
- (let-alist json
- (let* ((expiry-seconds-rel
- (time-to-seconds
- (time-subtract
- (encode-time
- (parse-time-string .expires_at))
- (current-time))))
- (expiry-str (format-time-string "%s" expiry-seconds-rel))
- (expiry-human (car
- (mastodon-tl--human-duration expiry-seconds-rel)))
- (options (mastodon-tl--map-alist 'title .options))
- (multiple (if (eq :json-false .multiple) nil t)))
- (if mastodon-toot-poll-use-transient
- (setq mastodon-toot-poll
- `((multi . ,multiple)
- (expiry . ,expiry-str)
- ;; (hide . ,hide)
- (one . ,(nth 0 options))
- (two . ,(nth 1 options))
- (three . ,(nth 2 options))
- (four . ,(nth 3 options))))
- (setq mastodon-toot-poll
- `( :options ,options :expiry-readable ,expiry-human
- :expiry ,expiry-str :multi ,multiple))))))
-
-\f
-;;; SCHEDULE
-
-(defun mastodon-toot-schedule-toot (&optional reschedule)
- "Read a date (+ time) in the minibuffer and schedule the current toot.
-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)
- (cond ((mastodon-tl--buffer-type-eq 'edit-toot)
- (user-error "You can't schedule toots you're editing"))
- ((not (or (mastodon-tl--buffer-type-eq 'new-toot)
- (mastodon-tl--buffer-type-eq 'scheduled-statuses)))
- (user-error "You can only schedule toots from the compose buffer or 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 "Toot scheduled for %s." msg-str))
- (let* ((args `(("scheduled_at" . ,iso8601-str)))
- (url (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 "Toot rescheduled for %s." msg-str)))))))))
-
-(defun mastodon-toot--iso-to-human (ts)
- "Format an ISO8601 timestamp TS to be more human-readable."
- (let* ((decoded (iso8601-parse ts))
- (encoded (encode-time decoded)))
- (format-time-string "%d-%m-%y, %H:%M[%z]" encoded)))
-
-(defun mastodon-toot--iso-to-org (ts)
- "Convert ISO8601 timestamp TS to something `org-read-date' can handle."
- (when ts
- (let* ((decoded (iso8601-parse ts)))
- (encode-time decoded))))
-
-\f
-;;; DISPLAY KEYBINDINGS
-
-(defun mastodon-toot--get-kbinds ()
- "Get a list of the keybindings in the `mastodon-toot-mode'."
- (let* ((binds (copy-tree mastodon-toot-mode-map))
- (prefix (car (cadr binds)))
- (bindings (remove nil
- (mapcar (lambda (i)
- (when (listp i) i))
- (cadr binds)))))
- (mapcar (lambda (b)
- (setf (car b) (vector prefix (car b)))
- b)
- bindings)))
-
-(defun mastodon-toot--format-kbind-command (cmd)
- "Format CMD to be more readable.
-e.g. `mastodon-toot-send' -> Send."
- (let* ((str (symbol-name cmd))
- (re "mastodon-toot-\\(.*\\)$")
- (str2 (save-match-data
- (string-match re str)
- (match-string 1 str))))
- (capitalize (replace-regexp-in-string "-" " " str2))))
-
-(defun mastodon-toot--format-kbind (kbind)
- "Format a single keybinding, KBIND, for display in documentation."
- (let ((key (concat "\\`"
- (help-key-description (car kbind) nil)
- "'"))
- (command (mastodon-toot--format-kbind-command (cdr kbind))))
- (substitute-command-keys
- (format
- (concat (mastodon-toot--comment " ")
- "%-10s"
- (mastodon-toot--comment " - %s"))
- key command))))
-
-(defun mastodon-toot--comment (str)
- "Propertize STR with `mastodon-toot-docs-face'."
- (propertize str
- 'face 'mastodon-toot-docs-face))
-
-(defun mastodon-toot--format-kbinds (kbinds)
- "Format a list of keybindings, KBINDS, for display in documentation."
- (mapcar #'mastodon-toot--format-kbind kbinds))
-
-(defvar-local mastodon-toot--kbinds-pairs nil
- "Contains a list of paired toot compose buffer keybindings for inserting.")
-
-(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest)
- "Return a list of strings each containing two formatted kbinds.
-KBINDS-LIST is the list of formatted bindings to pair.
-LONGEST is the length of the longest binding."
- (when kbinds-list
- (push (concat "\n"
- (car kbinds-list)
- (make-string (- (1+ longest) (length (car kbinds-list)))
- ?\ )
- (cadr kbinds-list))
- mastodon-toot--kbinds-pairs)
- (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest))
- (reverse mastodon-toot--kbinds-pairs))
-
-(defun mastodon-toot--kbinds-longest (kbinds-list)
- "Return the length of the longest item in KBINDS-LIST."
- (let ((lengths (mapcar #'length kbinds-list)))
- (car (sort lengths #'>))))
-
-\f
-;;; DISPLAY DOCS
-
-(defun mastodon-toot--make-mode-docs ()
- "Create formatted documentation text for `mastodon-toot-mode'."
- (let* ((kbinds (mastodon-toot--get-kbinds))
- (formatted (mastodon-toot--format-kbinds kbinds))
- (longest-kbind (mastodon-toot--kbinds-longest
- formatted)))
- (concat
- (mastodon-toot--comment
- " Compose a new toot here. The following keybindings are available:")
- (mapconcat
- #'identity
- (mastodon-toot--formatted-kbinds-pairs formatted longest-kbind)
- nil))))
-
-(defun mastodon-toot--format-reply-in-compose (reply-text)
- "Format a REPLY-TEXT for display in compose buffer docs."
- (let* ((rendered (mastodon-tl--render-text reply-text))
- (no-props (substring-no-properties rendered))
- ;; FIXME: this replaces \n at end of every post, so we have to trim:
- (no-newlines (string-trim
- (replace-regexp-in-string "[\n]+" " " no-props)))
- (reply-to (concat " Reply to: \"" no-newlines "\""))
- (crop (truncate-string-to-width reply-to
- mastodon-toot-orig-in-reply-length)))
- (if (> (length no-newlines)
- (length crop)) ; we cropped:
- (concat crop "\n")
- (concat reply-to "\n"))))
-
-(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text)
- "Insert propertized text with documentation about `mastodon-toot-mode'.
-Also includes and the status fields which will get updated based
-on the status of NSFW, content warning flags, media attachments, etc.
-REPLY-TEXT is the text of the toot being replied to."
- (let ((divider
- "|=================================================================|"))
- (insert
- (concat
- (mastodon-toot--make-mode-docs) "\n"
- (mastodon-toot--comment divider) "\n"
- (propertize
- (concat
- " "
- (propertize "Count"
- 'toot-post-counter t)
- " ⋅ "
- (propertize "Visibility"
- 'toot-post-visibility t)
- " ⋅ "
- (propertize "Language"
- 'toot-post-language t)
- " "
- (propertize "Scheduled"
- 'toot-post-scheduled t)
- " "
- (propertize "CW"
- 'toot-post-cw-flag t)
- " "
- (propertize "POLL"
- 'toot-post-poll-flag t)
- " "
- (propertize "NSFW"
- 'toot-post-nsfw-flag t)
- "\n"
- " Attachments: "
- (propertize "None "
- 'toot-attachments t)
- "\n"
- (when reply-text
- (propertize
- (mastodon-toot--format-reply-in-compose reply-text)
- 'toot-reply t))
- divider)
- 'face 'mastodon-toot-docs-face
- 'read-only "Edit your message below."
- 'toot-post-header t))
- ;; allow us to enter text after read-only header:
- (propertize "\n\n"
- 'rear-nonsticky t))))
-
-(defun mastodon-toot--most-restrictive-visibility (reply-visibility)
- "Return REPLY-VISIBILITY or default visibility, whichever is more restrictive.
-The default is given by `mastodon-toot--default-reply-visibility'."
- (unless (null reply-visibility)
- (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility)
- mastodon-toot-visibility-list)))
- (if (member (intern reply-visibility) less-restrictive)
- reply-visibility
- mastodon-toot--default-reply-visibility))))
-
-(defun mastodon-toot--render-reply-region-str (str)
- "Refill STR and prefix all lines with >, as reply-quote text."
- (with-temp-buffer
- (insert str)
- ;; unfill first:
- (let ((fill-column (point-max)))
- (fill-region (point-min) (point-max)))
- ;; then fill:
- (fill-region (point-min) (point-max))
- ;; add our own prefix, pauschal:
- (goto-char (point-min))
- (save-match-data
- (while (re-search-forward "^" nil t)
- (replace-match " > ")))
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id
- reply-json reply-region)
- "If REPLY-TO-USER is provided, inject their handle into the message.
-If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'.
-REPLY-JSON is the full JSON of the toot being replied to.
-REPLY-REGION is a string to be injected into the buffer."
- (let ((reply-visibility (mastodon-toot--most-restrictive-visibility
- (alist-get 'visibility reply-json)))
- (reply-cw (alist-get 'spoiler_text reply-json)))
- (when reply-to-user
- (when (> (length reply-to-user) 0) ; self is "" unforch
- (insert (format "%s " reply-to-user)))
- (when reply-region
- (insert "\n"
- (mastodon-toot--render-reply-region-str reply-region)
- "\n"))
- (setq mastodon-toot--reply-to-id reply-to-id)
- (unless (string= mastodon-toot--visibility reply-visibility)
- (setq mastodon-toot--visibility reply-visibility))
- (mastodon-toot--set-cw reply-cw))))
-
-(defun mastodon-toot--update-status-fields (&rest _args)
- "Update the status fields in the header based on the current state."
- (ignore-errors ;; called from after-change-functions so let's not leak errors
- (let* ((inhibit-read-only t)
- (header-region (mastodon-tl--find-property-range 'toot-post-header
- (point-min)))
- (count-region (mastodon-tl--find-property-range 'toot-post-counter
- (point-min)))
- (vis-region (mastodon-tl--find-property-range
- 'toot-post-visibility (point-min)))
- (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag
- (point-min)))
- (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag
- (point-min)))
- (lang-region (mastodon-tl--find-property-range 'toot-post-language
- (point-min)))
- (sched-region (mastodon-tl--find-property-range 'toot-post-scheduled
- (point-min)))
- (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag
- (point-min)))
- (toot-string (buffer-substring-no-properties (cdr header-region)
- (point-max))))
- (mastodon-toot--apply-fields-props
- count-region
- (format "%s/%s chars"
- (mastodon-toot--count-toot-chars toot-string)
- (number-to-string mastodon-toot--max-toot-chars)))
- (mastodon-toot--apply-fields-props
- vis-region
- (format "%s"
- (if (string= "private" mastodon-toot--visibility)
- "followers-only"
- mastodon-toot--visibility)))
- ;; WHEN clauses don't work here, we need "" as display arg:
- (mastodon-toot--apply-fields-props
- lang-region
- (if mastodon-toot--language
- (format "Lang: %s ⋅" mastodon-toot--language)
- ""))
- (mastodon-toot--apply-fields-props
- sched-region
- (if mastodon-toot--scheduled-for
- (format "Scheduled: %s ⋅"
- (mastodon-toot--iso-to-human
- mastodon-toot--scheduled-for))
- ""))
- (mastodon-toot--apply-fields-props
- nsfw-region
- (if mastodon-toot--content-nsfw
- (if mastodon-toot--media-attachments
- "NSFW" "NSFW (attachments only)")
- "")
- 'mastodon-cw-face)
- (mastodon-toot--apply-fields-props
- poll-region
- (if mastodon-toot-poll
- "POLL"
- "")
- 'mastodon-cw-face
- (prin1-to-string mastodon-toot-poll))
- (mastodon-toot--apply-fields-props
- cw-region
- (if (and mastodon-toot--content-warning
- (not (string= "" mastodon-toot--content-warning)))
- (format "CW: %s" mastodon-toot--content-warning)
- " ") ;; hold the blank space
- 'mastodon-cw-face))))
-
-(defun mastodon-toot--apply-fields-props (region display &optional face help-echo)
- "Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end."
- (add-text-properties (car region) (cdr region)
- `(display
- ,display
- ,@(when face `(face ,face))
- ,@(when help-echo `(help-echo ,help-echo)))))
-
-(defun mastodon-toot--count-toot-chars (toot-string &optional cw)
- "Count the characters in TOOT-STRING.
-URLs always = 23, and domain names of handles are not counted.
-This is how mastodon does it.
-CW is the content warning, which contributes to the character count."
- ;; FIXME: URL chars is avail at /api/v1/instance
- ;; for masto, it's .statuses.characters_reserved_per_url
- (let* ((url-replacement (make-string 23 ?x))
- (count-str
- (replace-regexp-in-string ; handle @handles
- mastodon-toot-handle-regex "\\4"
- (replace-regexp-in-string ; handle URLs
- mastodon-toot-url-regex url-replacement toot-string))))
- (+ (length cw)
- (length count-str))))
-
-\f
-;;; DRAFTS
-
-(defun mastodon-toot--save-toot-text (&rest _args)
- "Save the current toot text in `mastodon-toot-current-toot-text'.
-Added to `after-change-functions' in new toot buffers."
- (let ((text (mastodon-toot--remove-docs)))
- (unless (string-empty-p text)
- (setq mastodon-toot-current-toot-text text))))
-
-(defun mastodon-toot-open-draft-toot ()
- "Prompt for a draft and compose a toot with it."
- (interactive)
- (if mastodon-toot-draft-toots-list
- (let ((text (completing-read "Select draft toot: "
- mastodon-toot-draft-toots-list
- nil t)))
- (if (not (mastodon-toot--compose-buffer-p))
- (mastodon-toot--compose-buffer nil nil nil text)
- (when (and (not (mastodon-toot--empty-p :text-only))
- (y-or-n-p "Replace current text with draft?"))
- (cl-pushnew mastodon-toot-current-toot-text
- mastodon-toot-draft-toots-list)
- (goto-char
- (cdr (mastodon-tl--find-property-range 'toot-post-header
- (point-min))))
- (kill-region (point) (point-max))
- ;; to not save to kill-ring:
- ;; (delete-region (point) (point-max))
- (insert text))))
- (unless (mastodon-toot--compose-buffer-p)
- (mastodon-toot--compose-buffer))
- (message "No drafts available.")))
-
-(defun mastodon-toot-delete-draft-toot ()
- "Prompt for a draft toot and delete it."
- (interactive)
- (if (not mastodon-toot-draft-toots-list)
- (user-error "No drafts to delete")
- (let ((draft (completing-read "Select draft to delete: "
- mastodon-toot-draft-toots-list
- nil t)))
- (setq mastodon-toot-draft-toots-list
- (cl-delete draft mastodon-toot-draft-toots-list :test #'equal))
- (message "Draft deleted!"))))
-
-(defun mastodon-toot-delete-all-drafts ()
- "Delete all drafts."
- (interactive)
- (setq mastodon-toot-draft-toots-list nil)
- (message "All drafts deleted!"))
-
-\f
-;;; PROPERTIZE TAGS AND HANDLES
-
-(defun mastodon-toot--propertize-tags-and-handles (&rest _args)
- "Propertize tags and handles in toot compose buffer.
-Added to `after-change-functions'."
- (when (mastodon-toot--compose-buffer-p)
- (let ((header-region (mastodon-tl--find-property-range 'toot-post-header
- (point-min)))
- (face (when mastodon-toot--proportional-fonts-compose
- 'variable-pitch)))
- ;; cull any prev props:
- ;; stops all text after a handle or mention being propertized:
- (set-text-properties (cdr header-region) (point-max) `(face ,face))
- (mastodon-toot--propertize-item mastodon-toot-tag-regex
- 'success
- (cdr header-region))
- (mastodon-toot--propertize-item mastodon-toot-handle-regex
- 'mastodon-display-name-face
- (cdr header-region))
- (mastodon-toot--propertize-item mastodon-toot-url-regex
- 'link
- (cdr header-region)))))
-
-(defun mastodon-toot--propertize-item (regex face start)
- "Propertize item matching REGEX with FACE starting from START."
- (save-excursion
- (goto-char start)
- (cl-loop while (search-forward-regexp regex nil :noerror)
- do (add-text-properties (match-beginning 2)
- (match-end 2)
- `(face ,face)))))
-
-(defun mastodon-toot--compose-buffer-p ()
- "Return t if compose buffer is current."
- (or (mastodon-tl--buffer-type-eq 'edit-toot)
- (mastodon-tl--buffer-type-eq 'new-toot)))
-
-(defun mastodon-toot--fill-reply-in-compose ()
- "Fill reply text in compose buffer to the width of the divider."
- (save-excursion
- (save-match-data
- (let* ((fill-column 67))
- (goto-char (point-min))
- (when-let* ((prop (text-property-search-forward 'toot-reply)))
- (fill-region (prop-match-beginning prop)
- (point)))))))
-
-\f
-;;; COMPOSE BUFFER FUNCTION
-
-(defun mastodon-toot--compose-buffer
- (&optional reply-to-user reply-to-id reply-json initial-text edit)
- "Create a new buffer to capture text for a new toot.
-If REPLY-TO-USER is provided, inject their handle into the message.
-If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var.
-REPLY-JSON is the full JSON of the toot being replied to.
-INITIAL-TEXT is used by `mastodon-toot-insert-draft-toot' to add
-a draft into the buffer.
-EDIT means we are editing an existing toot, not composing a new one."
- (let* ((buffer-name (if edit "*edit toot*" "*new toot*"))
- (buffer-exists (get-buffer buffer-name))
- (buffer (if (not buffer-exists)
- (get-buffer-create buffer-name)
- ;; if a user hits reply while a compose buffer is already
- ;; open, we really ought to wipe it all and start over.
- (switch-to-buffer-other-window buffer-exists)
- (if (not (y-or-n-p "Overwrite existing compose buffer?"))
- (user-error "Aborting")
- (kill-buffer-and-window)
- (get-buffer-create buffer-name))))
- (inhibit-read-only t)
- (reply-text (alist-get 'content
- (or (alist-get 'reblog reply-json)
- reply-json)))
- (previous-window-config (list (current-window-configuration)
- (point-marker))))
- (switch-to-buffer-other-window buffer)
- (text-mode)
- (mastodon-toot-mode t)
- ;; set visibility:
- (setq mastodon-toot--visibility
- (or (plist-get mastodon-profile-account-settings 'privacy)
- ;; use toot visibility setting from the server:
- (mastodon-profile--get-source-value 'privacy)
- "public")) ; fallback
- ;; default language:
- ;; NB: this is not necessarily set in
- ;; `mastodon-profile-credential-account' nor in
- ;; `mastodon-profile-account-settings'!
- (setq mastodon-toot--language
- (mastodon-profile--get-preferences-pref 'posting:default:language))
- ;; display original toot:
- (if mastodon-toot-display-orig-in-reply-buffer
- (progn
- (mastodon-toot--display-docs-and-status-fields reply-text)
- (mastodon-toot--fill-reply-in-compose))
- (mastodon-toot--display-docs-and-status-fields))
- ;; `reply-to-user' (alone) is also used by `mastodon-tl-dm-user', so
- ;; perhaps we should not always call --setup-as-reply, or make its
- ;; workings conditional on reply-to-id. currently it only checks for
- ;; reply-to-user.
- (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json
- ;; only initial-text if reply (not edit):
- (when reply-json initial-text))
- (unless mastodon-toot--max-toot-chars
- ;; no need to fetch from `mastodon-profile-account-settings' as
- ;; `mastodon-toot--max-toot-chars' is set when we set it
- (mastodon-toot--get-max-toot-chars))
- ;; set up completion:
- (setq-local completion-ignore-case t)
- (when mastodon-toot--enable-completion
- (set (make-local-variable 'completion-at-point-functions)
- (add-to-list 'completion-at-point-functions
- #'mastodon-toot--mentions-capf))
- (add-to-list 'completion-at-point-functions
- #'mastodon-toot--tags-capf)
- (add-to-list 'completion-at-point-functions
- #'mastodon-toot--emoji-capf)
- ;; company
- (when (and mastodon-toot--use-company-for-completion
- (require 'company nil :no-error))
- (declare-function company-mode-on "company")
- (set (make-local-variable 'company-backends)
- (add-to-list 'company-backends 'company-capf))
- (company-mode-on)))
- ;; after-change:
- (make-local-variable 'after-change-functions)
- (cl-pushnew #'mastodon-toot--save-toot-text after-change-functions)
- (cl-pushnew #'mastodon-toot--update-status-fields after-change-functions)
- (mastodon-toot--update-status-fields)
- (cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions)
- (mastodon-toot--propertize-tags-and-handles)
- (mastodon-toot--refresh-attachments-display)
- ;; draft toot text saving:
- (setq mastodon-toot-current-toot-text nil)
- ;; if we set this before changing modes, it gets nuked:
- (setq mastodon-toot-previous-window-config previous-window-config)
- (when mastodon-toot--proportional-fonts-compose
- (facemenu-set-face 'variable-pitch))
- (when (and mastodon-use-emojify
- ;; emojify loaded but poss not enabled in our buffer:
- (boundp 'emojify-mode))
- (emojify-mode))
- (when (and initial-text
- (not reply-json))
- (insert initial-text))))
-
-;; flyspell ignore masto toot regexes:
-(defvar flyspell-generic-check-word-predicate)
-
-(defun mastodon-toot-mode-flyspell-verify ()
- "A predicate function for `flyspell'.
-Only text that is not one of these faces will be spell-checked."
- (let ((faces '(mastodon-display-name-face
- mastodon-toot-docs-face font-lock-comment-face
- success link)))
- (unless (eql (point) (point-min))
- ;; (point) is next char after the word. Must check one char before.
- (let ((f (get-text-property (1- (point)) 'face)))
- (not (memq f faces))))))
-
-(defun mastodon-toot-mode-hook-fun ()
- "Function for code to run in `mastodon-toot-mode-hook'."
- ;; disable auto-fill-mode:
- (auto-fill-mode -1)
- ;; add flyspell predicate function:
- (setq flyspell-generic-check-word-predicate
- #'mastodon-toot-mode-flyspell-verify))
-
-(add-hook 'mastodon-toot-mode-hook #'mastodon-toot-mode-hook-fun)
-
-;;;###autoload
-(add-hook 'mastodon-toot-mode-hook
- #'mastodon-profile--fetch-server-account-settings-maybe)
-
-
-(define-minor-mode mastodon-toot-mode
- "Minor mode for composing toots."
- :keymap mastodon-toot-mode-map
- :global nil)
-
-(provide 'mastodon-toot)
-;;; mastodon-toot.el ends here
+++ /dev/null
-;;; mastodon-transient.el --- transient menus for mastodon.el -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2024 martian hiatus
-
-;; Author: martian hiatus <mousebotNOSPAMdisroot.org>
-;; Keywords: convenience
-
-;; This program 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.
-
-;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'transient)
-(require 'tp)
-
-(defvar mastodon-active-user)
-(defvar mastodon-toot-visibility-settings-list)
-(defvar mastodon-iso-639-regional)
-(defvar mastodon-toot-poll)
-
-(autoload 'mastodon-toot-visibility-settings-list "mastodon-toot")
-(autoload 'mastodon-http--get-json "mastodon-http")
-(autoload 'mastodon-http--api "mastodon-http")
-(autoload 'mastodon-http--triage "mastodon-http")
-(autoload 'mastodon-http--patch "mastodon-http")
-(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile")
-(autoload 'mastodon-toot--fetch-max-poll-options "mastodon-toot")
-(autoload 'mastodon-toot--fetch-max-poll-option-chars "mastodon-toot")
-(autoload 'mastodon-instance-data "mastodon")
-(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
-(autoload 'mastodon-toot--read-poll-expiry "mastodon-toot")
-(autoload 'mastodon-toot--poll-expiry-options-alist "mastodon-toot")
-(autoload 'mastodon-toot-clear-poll "mastodon-toot")
-(autoload 'mastodon-notifications-get-policy "mastodon-notifications")
-
-;;; UTILS
-
-(transient-define-suffix mastodon-transient--prefix-inspect ()
- "Inspect a transient prefix's arguments and scope."
- (interactive)
- :transient 'transient--do-return
- (let ((args (transient-args (oref transient-current-prefix command)))
- (scope (oref transient-current-prefix scope)))
- (message "prefix's scope: %s \ntransient-args: %s\n last: %s"
- scope args
- (length
- (cl-member-if
- (lambda (x)
- (equal (car x) 'one))
- args)))))
-
-;; some JSON fields that are returned under the "source" field need to be
-;; sent back in the format source[key], while some others are sent kust as
-;; key:
-(defun mastodon-transient-parse-source-key (key)
- "Parse mastodon source KEY.
-If KEY needs to be source[key], format like so, else just return
-the inner key part."
- (let* ((split (split-string key "[][]"))
- (array-key (cadr split)))
- (if (or (= 1 (length split)) ;; no split
- (member array-key '("privacy" "sensitive" "language")))
- key
- array-key)))
-
-(defun mastodon-transient-parse-source-keys (alist)
- "Parse ALIST containing source[key] keys."
- (cl-loop for a in alist
- collect (cons (mastodon-transient-parse-source-key (car a))
- (cdr a))))
-
-(defun mastodon-transient-get-creds ()
- "Fetch account data."
- (mastodon-http--get-json
- (mastodon-http--api "accounts/verify_credentials")
- nil :silent))
-
-;; fields utils:
-;; to PATCH fields, we just need fields[x][name] and fields[x][value]
-
-(defun mastodon-transient--fields-alist (fields)
- "Convert fields in FIELDS to numbered conses.
-The keys in the data are not numbered, so we convert the key into
-the format fields.X.keyname."
- (cl-loop
- for f in fields
- for count from 1 to 5
- collect
- (cl-loop for x in f
- collect
- (cons (concat "fields." (number-to-string count)
- "." (symbol-name (car x)))
- (cdr x)))))
-
-(defun mastodon-transient-field-dot-to-array (key)
- "Convert KEY from tp dot annotation to array[key] annotation."
- (tp-dot-to-array (symbol-name key) nil "_attributes"))
-
-(defun mastodon-transient-dot-fields-to-arrays (alist)
- "Parse fields ALIST in dot notation to array notation."
- (cl-loop for y in alist
- collect
- (cons (mastodon-transient-field-dot-to-array (car y))
- (cdr y))))
-
-;;; TRANSIENTS
-
-;; FIXME: PATCHing source vals as JSON request body doesn't work! existing
-;; `mastodon-profile--update-preference' doesn't use it! it just uses
-;; query params! strange thing is it works for non-source params
-(transient-define-suffix mastodon-user-settings-update (&optional args)
- "Update current user settings on the server."
- :transient 'transient--do-exit
- (interactive (list (transient-args 'mastodon-user-settings)))
- (let* ((parsed (tp-parse-args-for-send args :strings))
- (strs (mastodon-transient-parse-source-keys parsed))
- (url (mastodon-http--api "accounts/update_credentials"))
- (resp (mastodon-http--patch url strs))) ;; :json fails
- (mastodon-http--triage
- resp
- (lambda (_resp)
- (message "Settings updated!\n%s" (pp-to-string strs))))))
-
-(transient-define-prefix mastodon-user-settings ()
- "A transient for setting current user settings."
- :value (lambda () (tp-return-data
- #'mastodon-transient-get-creds))
- [:description
- (lambda ()
- (format "User settings for %s" mastodon-active-user))
- (:info
- "Note: use the empty string (\"\") to remove a value from an option.")]
- ;; strings
- ["Account info"
- ("n" "display name" "display_name" :alist-key display_name :class tp-option-str)
- ("t" "update profile note" mastodon-update-profile-note)
- ("f" "update profile fields" mastodon-profile-fields)]
- ;; "choice" booleans (so we can PATCH :json-false explicitly):
- ["Account options"
- ("l" "locked" "locked" :alist-key locked :class tp-bool)
- ("b" "bot" "bot" :alist-key bot :class tp-bool)
- ("d" "discoverable" "discoverable" :alist-key discoverable :class tp-bool)
- ("c" "hide follower/following lists" "source.hide_collections"
- :alist-key source.hide_collections :class tp-bool)
- ("i" "indexable" "source.indexable" :alist-key source.indexable :class tp-bool)]
- ["Tooting options"
- ("p" "default privacy" "source.privacy" :alist-key source.privacy
- :class tp-option
- :choices (lambda () mastodon-toot-visibility-settings-list))
- ("s" "mark sensitive" "source.sensitive" :alist-key source.sensitive :class tp-bool)
- ("g" "default language" "source.language" :alist-key source.language :class tp-option
- :choices (lambda () mastodon-iso-639-regional))]
- ["Update"
- ("C-c C-c" "Save settings" mastodon-user-settings-update)
- ("C-x C-k" :info "Revert all changes")]
- (interactive)
- (if (or (not (boundp 'mastodon-active-user))
- (not mastodon-active-user))
- (user-error "User not set")
- (transient-setup 'mastodon-user-settings)))
-
-(transient-define-suffix mastodon-update-profile-note ()
- "Update current user profile note."
- :transient 'transient--do-exit
- (interactive)
- (mastodon-profile-update-user-profile-note))
-
-(transient-define-suffix mastodon-profile-fields-update (args)
- "Update current user profile fields."
- :transient 'transient--do-return
- (interactive (list (transient-args 'mastodon-profile-fields)))
- (let* (;; FIXME: maybe only changed also won't work with fields, as
- ;; perhaps what is PATCHed overwrites whatever is on the server?
- ;; (only-changed (tp-only-changed-args alist))
- (arrays (mastodon-transient-dot-fields-to-arrays args))
- (endpoint "accounts/update_credentials")
- (url (mastodon-http--api endpoint))
- (resp (mastodon-http--patch url arrays))) ; :json)))
- (mastodon-http--triage
- resp (lambda (_resp) (message "Fields updated!")))))
-
-(defun mastodon-transient-fetch-fields ()
- "Fetch profile fields (metadata)."
- (tp-return-data #'mastodon-transient-get-creds nil 'fields)
- (setq tp-transient-settings
- (mastodon-transient--fields-alist tp-transient-settings)))
-
-(transient-define-prefix mastodon-profile-fields ()
- "A transient for setting profile fields."
- :value (lambda () (mastodon-transient-fetch-fields))
- [:description
- "Fields"
- ["Name"
- ("1 n" "" "fields.1.name" :alist-key fields.1.name :class mastodon-transient-field)
- ("2 n" "" "fields.2.name" :alist-key fields.2.name :class mastodon-transient-field)
- ("3 n" "" "fields.3.name" :alist-key fields.3.name :class mastodon-transient-field)
- ("4 n" "" "fields.4.name" :alist-key fields.4.name :class mastodon-transient-field)]
- ["Value"
- ("1 v" "" "fields.1.value" :alist-key fields.1.value :class mastodon-transient-field)
- ("2 v" "" "fields.2.value" :alist-key fields.2.value :class mastodon-transient-field)
- ("3 v" "" "fields.3.value" :alist-key fields.3.value :class mastodon-transient-field)
- ("4 v" "" "fields.4.value" :alist-key fields.4.value :class mastodon-transient-field)]]
- ["Update"
- ("C-c C-c" "Save settings" mastodon-profile-fields-update)
- ("C-x C-k" :info "Revert all changes")]
- (interactive)
- (if (not mastodon-active-user)
- (user-error "User not set")
- (transient-setup 'mastodon-profile-fields)))
-
-(defun mastodon-transient-max-poll-opts ()
- "Return max poll options of user's instance."
- (let ((instance (mastodon-instance-data)))
- (mastodon-toot--fetch-max-poll-options instance)))
-
-(defun mastodon-transient-max-poll-opt-chars ()
- "Return max poll option characters of user's instance."
- (let ((instance (mastodon-instance-data)))
- (mastodon-toot--fetch-max-poll-option-chars instance)))
-
-(transient-define-suffix mastodon-transient-choice-add ()
- "Add another poll choice if possible.
-Do not add more than 9 choices.
-Do not add more than the server's maximum setting."
- (interactive)
- :transient 'transient--do-stay
- (let* ((args (transient-args (oref transient-current-prefix command)))
- (choice-count (length
- (cl-member-if
- (lambda (x)
- (equal (car x) 'one))
- args)))
- (inc (1+ choice-count))
- (next (number-to-string inc))
- (next-symbol (pcase inc
- (5 'five)
- (6 'six)
- (7 'seven)
- (8 'eight)
- (9 'nine))))
- (if (or (>= choice-count (mastodon-transient-max-poll-opts))
- (= choice-count 9))
- ;; FIXME when we hit '10', we get a binding clash with '1'. :/
- (message "Max choices reached")
- (transient-append-suffix
- 'mastodon-create-poll
- '(2 -1)
- `(,next "" ,next
- :class mastodon-transient-poll-choice
- :alist-key ,next-symbol
- :transient t))))
- (transient-setup 'mastodon-create-poll))
-
-(transient-define-prefix mastodon-create-poll ()
- "A transient for creating a poll."
- :value (lambda ()
- ;; we set `tp-transient-settings' here to the poll value poss
- ;; pulled from the server by
- ;; `mastodon-toot--server-poll-to-local'. when we are done with
- ;; the transient, we set `mastodon-toot-poll' again
- (setq tp-transient-settings mastodon-toot-poll))
- ["Create poll"
- (:info (lambda ()
- (format "Max options: %s"
- (mastodon-transient-max-poll-opts))))
- (:info (lambda ()
- (format "Max option length: %s"
- (mastodon-transient-max-poll-opt-chars))))]
- ["Options"
- ("m" "Multiple choice?" "multi" :alist-key multi
- :class mastodon-transient-poll-bool)
- ("h" "Hide vote count till expiry?" "hide" :alist-key hide
- :class mastodon-transient-poll-bool)
- ("e" "Expiry" "expiry" :alist-key expiry
- :class mastodon-transient-expiry)]
- ["Choices"
- ("1" "" "1" :alist-key one :class mastodon-transient-poll-choice)
- ("2" "" "2" :alist-key two :class mastodon-transient-poll-choice)
- ("3" "" "3" :alist-key three :class mastodon-transient-poll-choice)
- ("4" "" "4" :alist-key four :class mastodon-transient-poll-choice)]
- ;; TODO: display the max number of options or add options cmd
- ["Update"
- ("C-c C-s" "Add another poll choice" mastodon-transient-choice-add
- :if (lambda () (< 4 (mastodon-transient-max-poll-opts))))
- ("C-c C-c" "Save and done" mastodon-create-poll-done)
- ("C-x C-k" :info "Revert all")
- ("C-c C-k" "Delete all" mastodon-clear-poll)]
- (interactive)
- (if (not mastodon-active-user)
- (user-error "User not set")
- (transient-setup 'mastodon-create-poll)))
-
-(transient-define-suffix mastodon-clear-poll ()
- "Clear current poll data."
- :transient 'transient--do-stay
- (interactive)
- (mastodon-toot-clear-poll :transient)
- (transient-reset))
-
-(transient-define-suffix mastodon-create-poll-done (args)
- "Finish setting poll details."
- :transient 'transient--do-exit
- (interactive (list (transient-args 'mastodon-create-poll)))
- (let* ((options (cl-member-if (lambda (x)
- (eq (car x) 'one))
- args))
- (opt-vals (cl-loop for x in options
- collect (cdr x)))
- (lengths (mapcar #'length opt-vals))
- (vals (cl-remove 'nil
- (cl-loop for x in args
- collect (cdr x))))
- (opts-count (length (cl-remove 'nil opt-vals))))
- ;; this way of checking gets annoying if we want to just cancel out of
- ;; the poll (but to actually cancel user should C-g, not C-c C-c):
- (if (or (and (< 50 (apply #'max lengths))
- (not (y-or-n-p "Options longer than server max. Proceed? ")))
- (and (not (alist-get 'expiry args))
- (not (y-or-n-p "No expiry. Proceed? ")))
- (and (not (< 1 opts-count))
- (not (y-or-n-p "Need more than one option. Proceed? ")))
- (and (> opts-count (mastodon-transient-max-poll-opts))
- (not (y-or-n-p "More options than server max. Proceed? "))))
- (call-interactively #'mastodon-create-poll)
- ;; if we are called with no poll data, do not set:
- (unless (not vals)
- ;; we set `mastodon-toot-poll' here not `tp-transient-settings'
- ;; as that is our var outside of our transient:
- (setq mastodon-toot-poll
- (tp-bools-to-strs args)))
- (mastodon-toot--update-status-fields))))
-
-(defvar mastodon-notifications-policy-vals)
-(declare-function mastodon-notifications-get-policy "mastodon-notifications")
-(declare-function mastodon-notifications--update-policy "mastodon-notifications")
-
-(transient-define-prefix mastodon-notifications-policy ()
- "A transient to set notifications policy options."
- ;; https://docs.joinmastodon.org/methods/notifications/#get-policy
- :value (lambda () (tp-return-data #'mastodon-notifications-get-policy))
- ["Notification policy options"
- ("f" "people you don't follow" "for_not_following"
- :alist-key for_not_following :class mastodon-transient-policy)
- ("F" "people not following you" "for_not_followers"
- :alist-key for_not_followers :class mastodon-transient-policy)
- ("n" "New accounts" "for_new_accounts"
- :alist-key for_new_accounts :class mastodon-transient-policy)
- ("p" "Unsolicited private mentions" "for_private_mentions"
- :alist-key for_private_mentions :class mastodon-transient-policy)
- ("l" "Moderated accounts" "for_limited_accounts"
- :alist-key for_limited_accounts :class mastodon-transient-policy)
- (:info "")
- (:info "\"accept\" = receive notifications")
- (:info "\"filter\" = mark as filtered")
- (:info "\"drop\" = do not receive any notifications")]
- ["Notification requests"
- (:info #'mastodon-notifications-requests-count)
- (:info #'mastodon-notifications-filtered-count)]
- ["Update"
- ("C-c C-c" "Save settings" mastodon-notifications-policy-update)
- ("C-x C-k" :info "Revert all changes")])
-
-(defun mastodon-notifications-requests-count ()
- "Format a string for pending requests."
- (let ((val (oref transient--prefix value)))
- (format "Pending requests: %d"
- (or (map-nested-elt
- val
- '(summary pending_requests_count))
- 0))))
-
-(defun mastodon-notifications-filtered-count ()
- "Format a string for pending notifications."
- (let ((val (oref transient--prefix value)))
- (format "Pending notifications: %d"
- (or (map-nested-elt
- val
- '(summary pending_notifications_count))
- 0))))
-
-(transient-define-suffix mastodon-notifications-policy-update (args)
- "Send updated notification policy settings."
- :transient 'transient--do-exit
- ;; TODO:
- (interactive (list (transient-args 'mastodon-notifications-policy)))
- (let* ((parsed (tp-parse-args-for-send args))
- (resp (mastodon-notifications--update-policy parsed)))
- (mastodon-http--triage
- resp
- (lambda (_resp)
- (message "Settings updated!\n%s" (pp-to-string parsed))))))
-
-;;; CLASSES
-
-(defclass mastodon-transient-policy (tp-cycle)
- ((choices :initarg :choices :initform 'mastodon-notifications-policy-vals))
- "An option class for mastodon notification policy options.")
-
-(defclass mastodon-transient-field (tp-option-str)
- ((always-read :initarg :always-read :initform t))
- "An infix option class for our options.
-We always read.")
-
-(cl-defmethod transient-init-value ((obj mastodon-transient-field))
- "Initialize value of OBJ."
- (let* ((prefix-val (oref transient--prefix value)))
- ;; (arg (oref obj alist-key)))
- (oset obj value
- (tp-get-server-val obj prefix-val))))
-
-(cl-defmethod tp-get-server-val ((obj mastodon-transient-field) data)
- "Return the server value for OBJ from DATA.
-If OBJ's key has dotted notation, drill down into the alist. Currently
-only one level of nesting is supported."
- ;; TODO: handle nested alist keys
- (let* ((key (oref obj alist-key))
- (split (split-string (symbol-name key) "\\."))
- (num (string-to-number (cadr split))))
- (alist-get key
- (nth (1- num) data) nil nil #'string=)))
-
-(cl-defmethod tp-arg-changed-p ((_obj mastodon-transient-field) cons)
- "T if value of OBJ is changed from the server value.
-CONS is a cons of the form \"(fields.1.name . val)\"."
- (let* ((key-split (split-string
- (symbol-name (car cons)) "\\."))
- (num (1- (string-to-number (nth 1 key-split))))
- (server-key (symbol-name (car cons)))
- (server-elt (nth num tp-transient-settings)))
- (not (equal (cdr cons)
- (alist-get server-key server-elt nil nil #'string=)))))
-
-(defclass mastodon-transient-opt (tp-option tp-option-var)
- (()))
-
-(defclass mastodon-transient-poll-bool (tp-bool tp-option-var)
- ())
-
-(defclass mastodon-transient-poll-choice (tp-option-str tp-option-var)
- ())
-
-(cl-defmethod transient-infix-read ((obj mastodon-transient-poll-choice))
- "Reader function for OBJ, a poll expiry."
- (let* ((value (transient-infix-value obj))
- (prompt (transient-prompt obj))
- (str (read-string prompt (cdr value)))
- (max (mastodon-transient-max-poll-opt-chars)))
- (if (not (> (length str) max))
- str
- (if (not
- (y-or-n-p
- (format "Poll option too long for server (%s/%s chars), retry?"
- (length str) max)))
- str
- (oset obj value str)
- (transient-infix-read obj)))))
-
-(defclass mastodon-transient-expiry (tp-option tp-option-var)
- ())
-
-(cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry))
- "Reader function for OBJ, a poll expiry."
- (cdr (mastodon-toot--read-poll-expiry)))
-
-(cl-defmethod transient-format-value ((obj mastodon-transient-expiry))
- "Format function for OBJ, a poll expiry."
- (let* ((cons (transient-infix-value obj))
- (value (when cons (cdr cons))))
- (if (not value)
- ""
- (let ((readable
- (or (car
- (rassoc value
- (mastodon-toot--poll-expiry-options-alist)))
- (concat value " secs")))) ;; editing a poll wont match expiry list
- (propertize readable
- 'face (if (tp-arg-changed-p obj cons)
- 'transient-value
- 'transient-inactive-value))))))
-
-(provide 'mastodon-transient)
-;;; mastodon-transient.el ends here
+++ /dev/null
-;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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)
-(eval-when-compile
- (require 'mastodon-tl))
-
-(defvar mastodon-mode-map)
-(defvar mastodon-tl--horiz-bar)
-(defvar mastodon-tl--timeline-posts-count)
-
-(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-first-item "mastodon-tl")
-(autoload 'mastodon-tl--do-if-item "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")
-
-\f
-;;; 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 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)
- 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 "g") #'mastodon-views-view-filters)
- (define-key map (kbd "u") #'mastodon-views-update-filter)
- (define-key map (kbd "k") #'mastodon-views-delete-filter)
- (define-key map (kbd "a") #'mastodon-views-add-filter-kw)
- (define-key map (kbd "r") #'mastodon-views-remove-filter-kw)
- (define-key map (kbd "U") #'mastodon-views-update-filter-kw)
- 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)
- (define-key map (kbd "g") #'mastodon-views-view-lists)
- 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)
- (define-key map (kbd "g") #'mastodon-views-view-scheduled-toots)
- 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.")
-
-\f
-;;; GENERAL FUNCTION
-
-(defun mastodon-views--minor-view (view-name 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."
- ;; FIXME not tecnically an update-fun for init-sync, but just a simple way
- ;; to set up the empty buffer or else call the insert-fun. not sure if we cd
- ;; improve by eg calling init-sync in here, making this a real view function.
- (if (seq-empty-p data)
- (insert (propertize
- (format "Looks like you have no %s for now." view-name)
- 'face 'mastodon-toot-docs-face
- 'byline t
- 'item-type 'no-item ; for nav
- 'item-id "0")) ; so point can move here when no item
- (funcall insert-fun data)
- (goto-char (point-min)))
- ;; (when data
- ;; FIXME: this seems to trigger a new request, but ideally would run.
- ;; (mastodon-tl-goto-next-item))
- )
-
-\f
-;;; 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
- nil nil nil
- "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")
- (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
- "lists"
- #'mastodon-views--print-list-set
- json))
-
-(defun mastodon-views--print-list-set (lists)
- "Print each account plus a separator for each list in LISTS."
- (cl-loop for x in lists
- do (progn
- (mastodon-views--print-list-accounts x)
- (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n")
- 'face 'success)))))
-
-(defun mastodon-views--print-list-accounts (list)
- "Insert the accounts in list named LIST, an alist."
- (let-alist list
- (let* ((accounts (mastodon-views--accounts-in-list .id)))
- (insert
- (propertize .title
- 'byline t ; so we nav here
- 'item-id "0" ; so we nav here
- 'item-type 'list
- '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 .title
- 'list-id .id)
- (propertize (format " [replies: %s, exclusive %s]"
- .replies_policy
- (when (eq t .exclusive) "true"))
- 'face 'mastodon-toot-docs-face)
- (propertize "\n\n"
- 'list t
- 'keymap mastodon-views--list-name-keymap
- 'list-name .title
- 'list-id .id)
- (propertize
- (mapconcat #'mastodon-search--propertize-user accounts
- " ")
- 'list t
- 'keymap mastodon-views--list-name-keymap
- 'list-name .title
- '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"))
- (exclusive (if (y-or-n-p "Exclude items from home timeline? ")
- "true"
- "false"))
- (url (mastodon-http--api (format "lists/%s" id)))
- (response (mastodon-http--put url
- `(("title" . ,name-choice)
- ("replies_policy" . ,replies-policy)
- ("exclusive" . ,exclusive)))))
- (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 nil
- `(("limit" . ,mastodon-tl--timeline-posts-count)))))
-
-(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
- (exclusive (when (y-or-n-p "Exclude items from home timeline? ")
- "true"))
- (response (mastodon-http--post
- (mastodon-http--api "lists")
- `(("title" . ,title)
- ("replies_policy" . ,replies-policy)
- ("exclusive" . ,exclusive)))))
- (mastodon-views--list-action-triage
- response "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 "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 (unless handle
- (mastodon-views--get-users-followings)))
- (handles (unless handle
- (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)))
- (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 "%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 'item-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))
- (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 "%s removed from list %s!" account list-name)))
-
-(defun mastodon-views--list-action-triage (response &rest args)
- "Call `mastodon-http--triage' on RESPONSE and call message on ARGS."
- (mastodon-http--triage response
- (lambda (_)
- (when (mastodon-tl--buffer-type-eq 'lists)
- (mastodon-views-view-lists))
- (apply #'message args))))
-
-(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)))
-
-\f
-;;; 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"
- #'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
- nil
- '(("limit" . "40")) ; server max is 80
- :headers
- "follow requests"
- "a/j - accept/reject request at point\n\
- n/p - go to next/prev request")
- (mastodon-tl--goto-first-item)
- (with-current-buffer "*mastodon-follow-requests*"
- (use-local-map mastodon-views--view-follow-requests-keymap)))
-
-\f
-;;; SCHEDULED TOOTS
-
-;;;###autoload
-(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
- nil nil nil
- "your scheduled toots"
- "n/p - prev/next\n r - reschedule\n\
- e/RET - edit toot\n c - cancel")
- (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
- "scheduled toots"
- #'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-alist toot
- (insert
- (propertize (concat (string-trim .params.text)
- " | "
- (mastodon-toot--iso-to-human .scheduled_at))
- 'byline t ; so we nav here
- 'item-type 'scheduled ; so we nav here
- 'face 'mastodon-toot-docs-face
- 'keymap mastodon-views--scheduled-map
- 'item-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)
- (mastodon-tl--do-if-item
- (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)
- (mastodon-tl--do-if-item
- (when (or no-confirm
- (y-or-n-p "Cancel scheduled toot?"))
- (let* ((id (or id (mastodon-tl--property 'id :no-move)))
- (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)
- (mastodon-tl--do-if-item
- (let* ((toot (mastodon-tl--property 'scheduled-json :no-move))
- (id (mastodon-tl--property 'id :no-move))
- (scheduled (alist-get 'scheduled_at toot)))
- (let-alist (alist-get 'params toot)
- ;; TODO: preserve polls
- ;; (poll (alist-get 'poll params))
- (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit)
- (goto-char (point-max))
- ;; adopt properties from scheduled toot:
- (mastodon-toot--set-toot-properties
- .in_reply_to_id .visibility .spoiler_text .language
- scheduled id (alist-get 'media_attachments toot))))))
-
-\f
-;;; FILTERS
-
-;;;###autoload
-(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
- nil nil nil
- "current filters"
- "c/u - create/update filter | d/k - delete filter\
- at point\n a/r/U - add/remove/Update filter keyword\n\
- n/p - next/prev filter" "v2")
- (with-current-buffer "*mastodon-filters*"
- (use-local-map mastodon-views--view-filters-keymap)))
-
-(defun mastodon-views--insert-filters (json)
- "Insert a filter string plus a blank line.
-JSON is the filters data."
- (mapc #'mastodon-views--insert-filter json))
-
-(require 'table)
-
-(defun mastodon-views--insert-filter-kws (kws)
- "Insert filter keywords KWS."
- (insert "\n")
- (let ((beg (point))
- (table-cell-horizontal-chars (if (char-displayable-p ?–)
- "–"
- "-"))
- (whole-str "whole words only:"))
- (insert (concat "Keywords: | " whole-str "\n"))
- (cl-loop for kw in kws
- do (let ((whole (if (eq :json-false (alist-get 'whole_word kw))
- "nil"
- "t")))
- (insert
- (propertize (concat
- (format "\"%s\" | %s\n"
- (alist-get 'keyword kw) whole))
- 'kw-id (alist-get 'id kw)
- 'item-json kw
- 'mastodon-tab-stop t
- 'whole-word whole))))
- ;; table display of kws:
- (table-capture beg (point) "|" "\n" nil (+ 2 (length whole-str)))
- (table-justify-column 'center)
- (table-forward-cell) ;; col 2
- (table-justify-column 'center)
- (while (re-search-forward ;; goto end of table:
- (concat table-cell-horizontal-chars
- (make-string 1 table-cell-intersection-char)
- "\n")
- nil :no-error))))
-
-(defun mastodon-views--insert-filter (filter)
- "Insert a single FILTER."
- (let-alist filter
- (insert
- ;; FIXME: awful hack to fix nav: exclude horiz-bar from propertize then
- ;; propertize rest of the filter text. if we add only byline prop to
- ;; title, point will move to end of title, because at that byline-prop
- ;; change, item-type prop is present.
- (mastodon-tl--set-face
- (concat "\n " mastodon-tl--horiz-bar "\n ")
- 'success)
- (propertize
- (concat
- ;; heading:
- (mastodon-tl--set-face
- (concat (upcase .title) " " "\n "
- mastodon-tl--horiz-bar "\n")
- 'success)
- ;; context:
- (concat "Context: " (mapconcat #'identity .context ", "))
- ;; type (warn or hide):
- (concat "\nType: " .filter_action))
- 'item-json filter
- 'byline t
- 'item-id .id
- 'filter-title .title
- 'item-type 'filter))
- ;; terms list:
- (when .keywords ;; poss to have no keywords
- (mastodon-views--insert-filter-kws .keywords))))
-
-(defvar mastodon-views--filter-types
- '("home" "notifications" "public" "thread" "profile"))
-
-(defun mastodon-views-create-filter (&optional id title context type terms)
- "Create a filter for a word.
-Prompt for a context, must be a list containting at least one of \"home\",
-\"notifications\", \"public\", \"thread\".
-Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter."
- (interactive)
- ;; ID non-nil = we are updating
- (let* ((url (mastodon-http--api-v2
- (if id (format "filters/%s" id) "filters")))
- (title (or title (read-string "Filter name: ")))
- (terms (or terms
- (read-string "Terms to filter (comma or space separated): ")))
- (terms-split (split-string terms "[, ]"))
- (terms-processed
- (if (not terms) ;; well actually it is poss to have no terms
- (user-error "You must select at least one term")
- (mastodon-http--build-array-params-alist
- "keywords_attributes[][keyword]" terms-split)))
- (warn-or-hide
- (or type (completing-read "Warn (like CW) or hide? "
- '("warn" "hide") nil :match)))
- ;; TODO: display "home (and lists)" but just use "home" for API
- (contexts
- (or context (completing-read-multiple
- "Filter contexts [TAB for options, comma separated]: "
- mastodon-views--filter-types nil :match)))
- (contexts-processed
- (if (not contexts)
- (user-error "You must select at least one context")
- (mastodon-http--build-array-params-alist "context[]" contexts)))
- (params (append `(("title" . ,title)
- ("filter_action" . ,warn-or-hide))
- terms-processed
- contexts-processed))
- (resp (if id
- (mastodon-http--put url params)
- (mastodon-http--post url params))))
- (mastodon-views--filters-triage
- resp
- (message "Filter %s %s!" title (if id "updated" "created")))))
-
-(defun mastodon-views-update-filter ()
- "Update filter at point."
- (interactive)
- (if (not (eq 'filter (mastodon-tl--property 'item-type)))
- (user-error "No filter at point?")
- (let* ((filter (mastodon-tl--property 'item-json))
- (id (mastodon-tl--property 'item-id))
- (name (read-string "Name: " (alist-get 'title filter)))
- (contexts (completing-read-multiple
- "Filter contexts [TAB for options, comma separated]: "
- mastodon-views--filter-types nil :match
- (mapconcat #'identity
- (alist-get 'context filter) ",")))
- (type (completing-read "Warn (like CW) or hide? "
- '("warn" "hide") nil :match
- (alist-get 'type filter)))
- (terms (read-string "Terms to add (comma or space separated): ")))
- (mastodon-views-create-filter id name contexts type terms))))
-
-(defun mastodon-views-delete-filter ()
- "Delete filter at point."
- (interactive)
- (let* ((id (mastodon-tl--property 'item-id :no-move))
- (title (mastodon-tl--property 'filter-title :no-move))
- (url (mastodon-http--api-v2 (format "filters/%s" id))))
- (if (not (eq 'filter (mastodon-tl--property 'item-type)))
- (user-error "No filter at point?")
- (when (y-or-n-p (format "Delete filter %s? " title))
- (let ((resp (mastodon-http--delete url)))
- (mastodon-views--filters-triage
- resp
- (message "Filter \"%s\" deleted!" title)))))))
-
-(defun mastodon-views--get-filter-kw (&optional id)
- "GET filter with ID."
- (let* ((id (or id (mastodon-tl--property 'kw-id :no-move)))
- (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
- (resp (mastodon-http--get-json url)))
- resp))
-
-(defun mastodon-views-update-filter-kw ()
- "Update filter keyword.
-Prmopt to change the term, and the whole words option.
-When t, whole words means only match whole words."
- (interactive)
- (if (not (eq 'filter (mastodon-tl--property 'item-type)))
- (user-error "No filter at point?")
- (let* ((kws (alist-get 'keywords
- (mastodon-tl--property 'item-json :no-move)))
- (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
- (choice (completing-read "Update keyword: " alist))
- (updated (read-string "Keyword: " choice))
- (whole-word (if (y-or-n-p "Match whole words only? ")
- "true"
- "false"))
- (params `(("keyword" . ,updated)
- ("whole_word" . ,whole-word)))
- (id (cdr (assoc choice alist #'string=)))
- (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
- (resp (mastodon-http--put url params)))
- (mastodon-views--filters-triage resp
- (format "Keyword %s updated!" updated)))))
-
-(defun mastodon-views--filters-triage (resp msg-str)
- "Triage filter action response RESP, reload filters, message MSG-STR."
- (mastodon-http--triage
- resp
- (lambda (_resp)
- (when (mastodon-tl--buffer-type-eq 'filters)
- (mastodon-views-view-filters))
- (message msg-str))))
-
-(defun mastodon-views-add-filter-kw ()
- "Add a keyword to filter at point."
- (interactive)
- (if (not (eq 'filter (mastodon-tl--property 'item-type)))
- (user-error "No filter at point?")
- (let* ((kw (read-string "Keyword: "))
- (id (mastodon-tl--property 'item-id :no-move))
- (whole-word (if (y-or-n-p "Match whole words only? ")
- "true"
- "false"))
- (params `(("keyword" . ,kw)
- ("whole_word" . ,whole-word)))
- (url (mastodon-http--api-v2 (format "filters/%s/keywords" id)))
- (resp (mastodon-http--post url params)))
- (mastodon-views--filters-triage resp
- (format "Keyword %s added!" kw)))))
-
-(defun mastodon-views-remove-filter-kw ()
- "Remove keyword from filter at point."
- (interactive)
- (if (not (eq 'filter (mastodon-tl--property 'item-type)))
- (user-error "No filter at point?")
- (let* ((kws (alist-get 'keywords
- (mastodon-tl--property 'item-json :no-move)))
- (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
- (choice (completing-read "Remove keyword: " alist))
- (id (cdr (assoc choice alist #'string=)))
- (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
- (resp (mastodon-http--delete url)))
- (mastodon-views--filters-triage resp (format "Keyword %s removed!" choice)))))
-
-\f
-;;; FOLLOW SUGGESTIONS
-;; No pagination: max 80 results
-
-(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
- nil
- '(("limit" . "80")) ; server max
- nil
- "suggested accounts")
- (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"
- #'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))
-
-\f
-;;; 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--get-instance-url (url username &optional instance)
- "Return an instance base url from a user account URL.
-USERNAME is the name to cull.
-If INSTANCE is given, use that."
- (cond (instance (concat "https://" instance))
- ;; pleroma URL is https://instance.com/users/username
- ((string-suffix-p "users/" (url-basepath url))
- (string-remove-suffix "/users/"
- (url-basepath url)))
- ;; friendica is https://instance.com/profile/user
- ((string-suffix-p "profile/" (url-basepath url))
- (string-remove-suffix "/profile/"
- (url-basepath url)))
- ;; snac is https://instance.com/user
- ((not (string-match-p "@" url))
- ;; cull trailing slash:
- (string-trim-right (url-basepath url) "/"))
- ;; mastodon is https://instance.com/@user
- (t
- (string-remove-suffix (concat "/@" username)
- url))))
-
-(defun mastodon-views--get-own-instance ()
- "Return JSON of `mastodon-active-user's instance."
- (mastodon-http--get-json
- (mastodon-http--api "instance" "v2") nil nil :vector))
-
-(defun mastodon-views-view-instance-description
- (&optional user brief instance misskey)
- "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.
-MISSKEY means the instance is a Misskey or derived server."
- (interactive)
- (if user
- (let ((response (mastodon-views--get-own-instance)))
- (mastodon-views--instance-response-fun response brief instance))
- (mastodon-tl--do-if-item
- (let* ((toot (or (and (mastodon-tl--profile-buffer-p)
- (mastodon-tl--property 'profile-json)) ; either profile
- (mastodon-tl--property 'item-json))) ; or toot or user listing
- (reblog (alist-get 'reblog toot))
- (account (or (alist-get 'account reblog)
- (alist-get 'account toot)
- toot)) ; else `toot' is already an account listing.
- ;; we may be at toots/boosts/users in a profile buffer.
- ;; profile-json is a defacto test for if point is on the profile
- ;; details at the top of a profile buffer.
- (profile-note-p (and (mastodon-tl--profile-buffer-p)
- ;; only call this in profile buffers:
- (mastodon-tl--property 'profile-json)))
- (url (if profile-note-p
- (alist-get 'url toot) ; profile description
- (alist-get 'url account)))
- (username (if profile-note-p
- (alist-get 'username toot) ;; profile
- (alist-get 'username account)))
- (instance (mastodon-views--get-instance-url url username instance)))
- (if misskey
- (let* ((params `(("detail" . ,(or brief t))))
- (headers '(("Content-Type" . "application/json")))
- (url (concat instance "/api/meta"))
- (response
- (with-current-buffer (mastodon-http--post url params headers t :json)
- (mastodon-http--process-response))))
- (mastodon-views--instance-response-fun response brief instance :misskey))
- (let ((response (mastodon-http--get-json
- (concat instance "/api/v1/instance") nil nil :vector)))
- ;; if non-misskey attempt errors, try misskey instance:
- ;; akkoma i guess should not error here.
- (if (eq 'error (caar response))
- (mastodon-views-instance-desc-misskey)
- (mastodon-views--instance-response-fun response brief instance))))))))
-
-(defun mastodon-views-instance-desc-misskey (&optional user brief instance)
- "Show instance description for a misskey/firefish server.
-USER, BRIEF, and INSTANCE are all for
-`mastodon-views-view-instance-description', which see."
- (interactive)
- (mastodon-views-view-instance-description user brief instance :miskey))
-
-(defun mastodon-views--instance-response-fun (response brief instance
- &optional misskey)
- "Display instance description RESPONSE in a new buffer.
-BRIEF means to show fewer details.
-INSTANCE is the instance were are working with.
-MISSKEY means the instance is a Misskey or derived server."
- (when response
- (let* ((domain (url-file-nondirectory instance))
- (buf (get-buffer-create
- (format "*mastodon-instance-%s*" domain))))
- (with-mastodon-buffer buf #'special-mode :other-window
- (if misskey
- (mastodon-views--insert-json response)
- (condition-case nil
- (progn
- (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-tl--set-buffer-spec (buffer-name buf) "instance" nil)
- (goto-char (point-min)))
- (error ; just insert the raw response:
- (mastodon-views--insert-json response))))))))
-
-(defun mastodon-views--insert-json (response)
- "Insert raw JSON RESPONSE in current buffer."
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (prin1-to-string response))
- (pp-buffer)
- (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+ (apply #'max (mapcar #'length cars)))))
- (while response
- (let ((el (pop response)))
- (cond
- ((and (vectorp (cdr el)) ; vector of alists (fields, instance rules):
- (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"))
- ((and (vectorp (cdr el)) ; vector of strings (media types):
- (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"))
- ((consp (cdr el)) ; basic nesting:
- (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 ((eq (cdr el) :json-false)
- "no")
- ((eq (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 to --render-text (for hyperlinks):
- (mastodon-tl--render-text
- (if (stringp val) val (prin1-to-string val)))
- "\n"))))))))
-
-(defun mastodon-views--print-instance-rules-or-fields (alist)
- "Print ALIST of instance rules or contact account or emoji fields."
- (let-alist alist
- (let ((key (or .id .name .shortcode))
- (value (or .text .value .url)))
- (indent-to 4)
- (insert (format "%-5s: "
- (propertize key 'face '(:underline t)))
- (mastodon-views--newline-if-long value)
- (format "%s" (mastodon-tl--render-text
- value))
- "\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
+++ /dev/null
-;;; mastodon-widget.el --- Widget utilities -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2024 Marty Hiatt
-;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; 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:
-
-;; some widget utilities for mastodon.el
-
-;;; Code:
-
-(require 'cl-lib)
-
-(defvar mastodon-widget-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [down-mouse-2] 'widget-button-click)
- (define-key map [down-mouse-1] 'widget-button-click)
- (define-key map [touchscreen-begin] 'widget-button-click)
- ;; The following definition needs to avoid using escape sequences that
- ;; might get converted to ^M when building loaddefs.el
- (define-key map [(control ?m)] 'widget-button-press)
- map)
- "Keymap containing useful binding for buffers containing widgets.
-Recommended as a parent keymap for modes using widgets.
-Note that such modes will need to require wid-edit.")
-
-(defface mastodon-widget-face
- '((t :inherit font-lock-function-name-face :weight bold :underline t))
- "Face for widgets."
- :group 'mastodon)
-
-(defun mastodon-widget--return-item-widgets (list)
- "Return a list of item widgets for each item, a string, in LIST."
- (cl-loop for x in list
- collect `(choice-item :value ,x :format "%[%v%] "
- :keymap ,mastodon-widget-keymap)))
-
-(defun mastodon-widget--format (str &optional padding newline)
- "Return a widget format string for STR, its name.
-PADDING is an integer, for how much right-side padding to add."
- (concat "%[" (propertize str
- 'face 'mastodon-widget-face
- 'mastodon-tab-stop t)
- "%]: %v"
- (make-string padding ? )
- (if newline "\n" "")))
-
-(defun mastodon-widget--create (kind type value notify-fun
- &optional newline)
- "Return a widget of KIND, with TYPE elements, and default VALUE.
-KIND is a string, either Listing, Sort, Items, or Inbox, and will
-be used for the widget's tag.
-VALUE is a string, a member of TYPE.
-NOTIFY-FUN is the widget's notify function."
- (let* ((val-length (length (if (symbolp value)
- (symbol-name value)
- value)))
- (type-list (if (symbolp type)
- (symbol-value type)
- type))
- (longest (apply #'max
- (mapcar #'length
- (if (symbolp (car type-list))
- (mapcar #'symbol-name type-list)
- type-list))))
- (padding (- longest val-length)))
- (if (not (member value type-list))
- (user-error "%s is not a member of %s" value type-list)
- (widget-create
- 'menu-choice
- :tag kind
- :value value
- :args (mastodon-widget--return-item-widgets type-list)
- :help-echo (format "Select a %s kind" kind)
- :format (mastodon-widget--format kind padding newline)
- :notify notify-fun
- ;; eg format of notify-fun:
- ;; (lambda (widget &rest ignore)
- ;; (let ((value (widget-value widget))
- ;; (tag (widget-get widget :tag)))
- ;; (notify-fun value)))
- :keymap mastodon-widget-keymap))))
-
-(provide 'mastodon-widget)
-;;; mastodon-widget.el ends here
+++ /dev/null
-;;; mastodon.el --- Client for fediverse services using the Mastodon API -*- lexical-binding: t -*-
-
-;; Copyright (C) 2017-2019 Johnson Denen
-;; Copyright (C) 2020-2022 Marty Hiatt
-;; Copyright (C) 2021 Abhiseck Paira <abhiseckpairaNOSPAMdisroot.org>
-;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
-;; Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
-;; Package-Version: 20251201.1553
-;; Package-Revision: 3c00418bfbb1
-;; Package-Requires: ((emacs "28.1") (persist "0.8") (tp "0.7"))
-;; 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.el is a client for fediverse services that implement the Mastodon
-;; API. See <https://github.com/mastodon/mastodon>.
-
-;; For set up and usage details, see the Info documentation, or the readme
-;; file at <https://codeberg.org/martianh/mastodon.el>.
-
-;;; Code:
-(require 'cl-lib) ; for `cl-some' call in `mastodon'
-(eval-when-compile (require 'subr-x))
-(require 'url)
-(require 'thingatpt)
-(require 'shr)
-
-(require 'mastodon-http)
-(require 'mastodon-toot)
-(require 'mastodon-search)
-(require 'mastodon-transient)
-(require 'mastodon-tl)
-
-(declare-function discover-add-context-menu "discover")
-(declare-function emojify-mode "emojify")
-(declare-function request "request")
-
-(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-notifications-policy "mastodon-notifications")
-(autoload 'mastodon-notifications-requests "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-toot-edit-toot-at-point "mastodon-toot")
-(when (require 'lingva nil :no-error)
- (autoload 'mastodon-toot-translate-toot-text "mastodon-toot"))
-(autoload 'mastodon-toot--view-toot-history "mastodon-tl")
-(autoload 'mastodon-tl-return "mastodon-tl")
-(autoload 'mastodon-tl-jump-to-followed-tag "mastodon-tl")
-
-;; for M-x visibility
-;; (views.el uses `mastodon-mode-map', so we can't easily require it)
-(autoload 'mastodon-views-view-follow-suggestions "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-view-filters "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-view-follow-requests "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-view-own-instance "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-view-instance-description "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-view-lists "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-view-scheduled-toots "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-add-account-to-list "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-add-toot-account-at-point-to-list "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-create-list "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-create-filter "mastodon-views"
- nil :interactive)
-(autoload 'mastodon-views-view-list-timeline "mastodon-views"
- nil :interactive)
-
-(autoload 'special-mode "simple")
-
-(defvar mastodon-tl--highlight-current-toot)
-(defvar mastodon-notifications--map)
-(defvar mastodon-client--token-file)
-
-(defvar mastodon-notifications-grouped-types
- '("reblog" "favourite") ;; TODO: implement follow!
- "List of notification types for which grouping is implemented.
-Used in `mastodon-notifications-get'")
-
-(defgroup mastodon nil
- "Interface with Mastodon."
- :prefix "mastodon-"
- :group 'external)
-
-(defcustom mastodon-instance-url "https://mastodon.social"
- "Base URL for the fediverse instance you want to be active.
-For example, if your username is
-\"example_userNOSPAMsocial.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."
- :type 'string)
-
-(defcustom mastodon-active-user nil
- "Username of the active user.
-For example, if your username is
-\"example_userNOSPAMsocial.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."
- :type 'string)
-
-(defcustom mastodon-toot-timestamp-format "%F %T"
- "Format to use for timestamps.
-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."
- :type 'string)
-
-(defcustom mastodon-use-emojify nil
- "Whether to use emojify.el to display emojis.
-From version 28, Emacs can display emojis natively. But
-currently, it doesn't seem to have a way to handle custom emoji,
-while emojify,el has this feature and mastodon.el implements it."
- :type 'boolean)
-
-;; notifications customizes
-;; moved here because we can load notifs without first loading mastodon.el
-;; or mastodon-notifications.el
-
-(defcustom mastodon-profile-note-in-foll-reqs t
- "If non-nil, show a user's profile note in follow request notifications."
- :type '(boolean))
-
-(defcustom mastodon-profile-note-in-foll-reqs-max-length nil
- "The max character length for user profile note in follow requests.
-Profile notes are only displayed if
-`mastodon-profile-note-in-foll-reqs' is non-nil.
-If unset, profile notes of any size will be displayed, which may
-make them unweildy."
- :type '(integer))
-
-(defcustom mastodon-images-in-notifs nil
- "Whether to display attached images in notifications."
- :type '(boolean))
-
-(defcustom mastodon-group-notifications nil
- "Whether to use grouped notifications.
-Requires that your instance actually implements grouped notifications.
-Mastodon implemented them in 4.3."
- :type '(boolean))
-
-(defcustom mastodon-notifications-grouped-names-count 2
- "The number of notification authors to display.
-A count of 2 for example means to display like so: \"Bob, Jenny
-and X others...\"."
- :type '(integer))
-
-(defun mastodon-kill-window ()
- "Quit window and delete helper."
- (interactive)
- (quit-window 'kill))
-
-(defvar mastodon-client--active-user-details-plist)
-(defvar mastodon-auth--token-alist)
-
-;;;###autoload
-(defun mastodon-forget-all-logins ()
- "Delete `mastodon-client--token-file'.
-Also nil `mastodon-auth--token-alist'."
- (interactive)
- (when (y-or-n-p "Remove all saved login data?")
- (if (not (file-exists-p mastodon-client--token-file))
- (message "No plstore file")
- (delete-file mastodon-client--token-file)
- (message "File %s deleted." mastodon-client--token-file))
- ;; nil some vars too:
- (setq mastodon-client--active-user-details-plist nil)
- (setq mastodon-auth--token-alist nil)))
-
-(defvar mastodon-mode-map
- (let ((map (make-sparse-keymap)))
- ;; navigation inside a timeline
- (define-key map (kbd "n") #'mastodon-tl-goto-next-item)
- (define-key map (kbd "p") #'mastodon-tl-goto-prev-item)
- (define-key map (kbd "M-n") #'mastodon-tl-next-tab-item)
- (define-key map (kbd "M-p") #'mastodon-tl-previous-tab-item)
- (define-key map [?\t] #'mastodon-tl-next-tab-item)
- (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 "C-\"") #'mastodon-tl-jump-to-followed-tag)
- (define-key map (kbd "'") #'mastodon-tl-followed-tags-timeline)
- (define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline)
- (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 "S-C-n") #'mastodon-notifications-requests)
- (define-key map (kbd "@") #'mastodon-notifications-get-mentions)
- (define-key map (kbd "P") #'mastodon-profile-show-user)
- (define-key map (kbd "s") #'mastodon-search-query)
- (define-key map (kbd "/") #'mastodon-switch-to-buffer)
- (define-key map (kbd "\\") #'mastodon-tl-get-remote-local-timeline)
- ;; quitting mastodon
- (define-key map (kbd "q") #'kill-current-buffer)
- (define-key map (kbd "Q") #'mastodon-kill-window)
- (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)
- (define-key map (kbd "C") #'mastodon-toot-copy-toot-url)
- (define-key map (kbd "o") #'mastodon-toot-browse-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)
- (define-key map (kbd "RET") #'mastodon-tl-return)
- (define-key map (kbd "m") #'mastodon-tl-dm-user)
- (define-key map (kbd "=") #'mastodon-tl-view-first-full-image)
- (when (require 'lingva nil :no-error)
- (define-key map (kbd "a") #'mastodon-toot-translate-toot-text))
- (define-key map (kbd ",") #'mastodon-toot-list-favouriters)
- (define-key map (kbd ".") #'mastodon-toot-list-boosters)
- (define-key map (kbd ";") #'mastodon-views-view-instance-description)
- (define-key map (kbd "M-;") #'mastodon-tl-nodeinfo-for-toot)
- ;; override special mode binding
- (define-key map (kbd "g") #'undefined)
- (define-key map (kbd "g") #'mastodon-tl-update)
- ;; 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)
- (define-key map (kbd "Z") #'mastodon-tl-report-to-mods)
- ;; own profile
- (define-key map (kbd "O") #'mastodon-profile-my-profile)
- (define-key map (kbd "U") #'mastodon-profile-update-user-profile-note)
- (define-key map (kbd "V") #'mastodon-profile-view-favourites)
- (define-key map (kbd "K") #'mastodon-profile-view-bookmarks)
- (define-key map (kbd ":") #'mastodon-user-settings)
- (define-key map (kbd "C-:") #'mastodon-notifications-policy)
- ;; 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)
- (define-key map (kbd "SPC") #'mastodon-tl-scroll-up-command)
- (define-key map (kbd "!") #'mastodon-tl-fold-post-toggle)
- (define-key map (kbd "z") #'bury-buffer)
- map)
- "Keymap for `mastodon-mode'.")
-
-(defcustom mastodon-mode-hook nil
- "Hook run when entering Mastodon mode."
- :type 'hook
- :options '(provide-discover-context-menu))
-
-(defface mastodon-handle-face
- '((t :inherit default))
- "Face used for user handles in bylines.")
-
-(defface mastodon-display-name-face
- '((t :inherit warning))
- "Face used for user display names.")
-
-(defface mastodon-boosted-face
- '((t :inherit success :weight bold))
- "Face to indicate that a toot is boosted.")
-
-(defface mastodon-boost-fave-face
- '((t :inherit success))
- "Face to indicate that you have boosted or favourited a toot.")
-
-(defface mastodon-cw-face
- '((t :inherit success))
- "Face used for content warning.")
-
-(defface mastodon-toot-docs-face
- `((t :inherit shadow))
- "Face used for documentation in toot compose buffer.
-If `mastodon-tl--enable-proportional-fonts' is changed,
-mastodon.el needs to be re-loaded for this to be correctly set.")
-
-(defface mastodon-toot-docs-reply-text-face
- `((t :inherit font-lock-comment-face
- :family ,(face-attribute 'variable-pitch :family)))
- "Face used for reply text in toot compose buffer.
-See `mastodon-toot-display-orig-in-reply-buffer'.")
-
-(defface mastodon-cursor-highlight-face
- `((t :inherit highlight :extend t))
- "Face for `mastodon-tl--highlight-current-toot'.")
-
-;;;###autoload
-(defun mastodon ()
- "Connect client to `mastodon-instance-url' instance.
-If there are any open mastodon.el buffers, switch to one instead.
-Prority in switching is given to timeline views."
- (interactive)
- (let* ((tls (list "home"
- "local"
- "federated"
- (concat (mastodon-auth--user-acct) "-statuses") ; own profile
- "favourites"
- "search"))
- (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
- (pop-to-buffer buffer '(display-buffer-same-window))
- ;; we need to update credential-account in case setting have been changed
- ;; outside mastodon.el in the meantime:
- (mastodon-return-credential-account :force)
- (mastodon-tl-get-home-timeline)
- (message "Loading fediverse account %s on %s..."
- (mastodon-auth--user-acct)
- mastodon-instance-url))))
-
-(defvar mastodon-profile-credential-account nil)
-
-;; TODO: the get request in mastodon-http--get-response often returns nil
-;; after waking from sleep, not sure how to fix, or if just my pc.
-;; interestingly it only happens with this function tho.
-(defun mastodon-return-credential-account (&optional force)
- "Return the CredentialAccount entity.
-Either from `mastodon-profile-credential-account' or from the
-server if that var is nil.
-FORCE means to fetch from the server in any case and update
-`mastodon-profile-credential-account'."
- (if (or force (not mastodon-profile-credential-account))
- (setq mastodon-profile-credential-account
- ;; TODO: we should signal a quit condition after 5 secs here
- (condition-case nil
- (mastodon-http--get-json
- (mastodon-http--api "accounts/verify_credentials")
- nil :silent)
- (t ; req fails, return old value
- mastodon-profile-credential-account)))
- ;; else just return the var:
- mastodon-profile-credential-account))
-
-(defvar mastodon-instance-data nil
- "Instance data from the instance endpoint.")
-
-(defun mastodon-instance-data ()
- "Return `mastodon-instnace-data' or else fetch from instance endpoint."
- (or mastodon-instance-data
- (setq mastodon-instance-data
- (mastodon-http--get-json (mastodon-http--api "instance")))))
-
-(defun mastodon-instance-version ()
- "Return the version string of user's instance."
- (alist-get 'version (mastodon-instance-data)))
-
-;;;###autoload
-(defun mastodon-toot (&optional user reply-to-id reply-json)
- "Update instance with new toot. Content is captured in a new buffer.
-If USER is non-nil, insert after @ symbol to begin new toot.
-If REPLY-TO-ID is non-nil, attach new toot to a conversation.
-If REPLY-JSON is the json of the toot being replied to."
- (interactive)
- (mastodon-toot--compose-buffer user reply-to-id reply-json))
-
-;;;###autoload
-(defun mastodon-notifications-get (&optional type buffer-name max-id)
- "Display NOTIFICATIONS in buffer.
-Optionally only print notifications of type TYPE, a string.
-BUFFER-NAME is added to \"*mastodon-\" to create the buffer name.
-MAX-ID is a request parameter for pagination."
- (interactive)
- (let* ((buffer-name (or buffer-name "notifications"))
- (buffer (concat "*mastodon-" buffer-name "*")))
- (message "Loading your notifications...")
- (mastodon-tl--init-sync
- buffer-name
- "notifications"
- 'mastodon-notifications--timeline
- type
- `(,@(when mastodon-group-notifications
- (mastodon-http--build-array-params-alist
- "grouped_types[]" mastodon-notifications-grouped-types))
- ,@(when max-id
- `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))
- nil nil nil
- (if (or (not mastodon-group-notifications)
- ;; if version less than 1st grouped notifs release:
- (> 4.3 (string-to-number
- (mastodon-instance-version))))
- "v1"
- "v2"))
- (with-current-buffer (get-buffer-create buffer)
- (use-local-map mastodon-notifications--map))
- (message "Loading your notifications... Done")))
-
-;; URL lookup: should be available even if `mastodon.el' not loaded:
-
-;;;###autoload
-(defun mastodon-url-lookup (&optional query-url force)
- "If a URL resembles a fediverse link, try to load in `mastodon.el'.
-Does a WebFinger lookup on the server.
-URL can be arg QUERY-URL, or URL at point, or provided by the user.
-If a status or account is found, load it in `mastodon.el', if
-not, just browse the URL in the normal fashion.
-If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'."
- (interactive)
- (let* ((query (or query-url
- (mastodon-tl--property 'shr-url :no-move)
- (thing-at-point-url-at-point)
- (read-string "Lookup URL: "))))
- (if (and (not force)
- (not (mastodon--fedi-url-p query)))
- ;; (shr-browse-url query) ; doesn't work (keep our shr keymap)
- (progn (message "Using external browser")
- (browse-url query))
- (message "Performing lookup...")
- (let* ((url (format "%s/api/v2/search" mastodon-instance-url))
- (params `(("q" . ,query)
- ("resolve" . "t"))) ; webfinger
- (response (mastodon-http--get-json url params :silent)))
- (cond ((not (seq-empty-p (alist-get 'statuses response)))
- (let* ((statuses (assoc 'statuses response))
- (status (seq-first (cdr statuses)))
- (status-id (alist-get 'id status)))
- (mastodon-tl--thread-do status-id)))
- ((not (seq-empty-p (alist-get 'accounts response)))
- (let* ((accounts (assoc 'accounts response))
- (account (seq-first (cdr accounts))))
- (mastodon-profile--make-author-buffer account)))
- (t
- (message "Lookup failed. Using external browser")
- (browse-url query)))))))
-
-(defun mastodon-url-lookup-force ()
- "Call `mastodon-url-lookup' without checking if URL is fedi-like."
- (interactive)
- (mastodon-url-lookup nil :force))
-
-(defun mastodon--fedi-url-p (url)
- "Check if QUERY resembles a fediverse URL."
- ;; calqued off https://github.com/tuskyapp/Tusky/blob/c8fc2418b8f5458a817bba221d025b822225e130/app/src/main/java/com/keylesspalace/tusky/BottomSheetActivity.kt
- ;; thx to Conny Duck!
- ;; mastodon at least seems to allow only [a-z0-9_] for usernames, plus "."
- ;; but not at beginning or end, see https://github.com/mastodon/mastodon/issues/6830
- ;; objects may have - in them
- (let* ((uri-parsed (url-generic-parse-url url))
- (query (url-filename uri-parsed)))
- (save-match-data
- (or (string-match "^/@[^/]+$" query)
- (string-match "^/@[^/]+/[[:digit:]]+$" query)
- (string-match "^/user[s]?/@?[[:alnum:]_]+$" query) ; @: pleroma or soapbox
- (string-match "^/notice/[[:alnum:]]+$" query)
- (string-match "^/objects/[-a-f0-9]+$" query)
- (string-match "^/notes/[a-z0-9]+$" query)
- (string-match "^/display/[-a-f0-9]+$" query)
- (string-match "^/profile/[[:alpha:]_]+$" query)
- (string-match "^/p/[[:alpha:]_]+/[[:digit:]]+$" query)
- (string-match "^/[[:alpha:]_]+$" query)
- (string-match "^/u/[[:alpha:]_]+$" query)
- (string-match "^/c/[[:alnum:]_]+$" query)
- (string-match "^/post/[[:digit:]]+$" query)
- (string-match "^/comment/[[:digit:]]+$" query) ; lemmy
- (string-match "^/@[^/]+/statuses/[[:alnum:]]" query) ; GTS
- (string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" query) ; hometown
- (string-match "^/notes/[[:alnum:]]+$" query) ; misskey post
- (string-match "^/w/[[:alnum:]_]+$" query) ; peertube post
- ;; bsky via fed.brid.gy (unsure if this needs narrowing down?):
- (string-prefix-p "https://fed.brid.gy/r/" url)))))
-
-(defun mastodon-live-buffers ()
- "Return a list of open mastodon buffers.
-Calls `mastodon-tl--get-buffer-type', which see."
- (cl-loop for x in (buffer-list)
- when (with-current-buffer x (mastodon-tl--get-buffer-type))
- collect (get-buffer x)))
-
-(defun mastodon-buffer-p (&optional buffer)
- "Non-nil if BUFFER or `current-buffer' is a mastodon one."
- (let ((buf (or buffer (current-buffer))))
- (member buf (mastodon-live-buffers))))
-
-(defun mastodon-kill-all-buffers ()
- "Kill any and all open mastodon buffers, hopefully."
- (interactive)
- (let ((mastodon-buffers (mastodon-live-buffers)))
- (cl-loop for x in mastodon-buffers
- do (kill-buffer x))))
-
-(defun mastodon-switch-to-buffer ()
- "Switch to a live mastodon buffer."
- (interactive)
- (let ((choice (completing-read
- "Switch to mastodon buffer: "
- (mapcar #'buffer-name (mastodon-live-buffers))
- nil :match)))
- (switch-to-buffer choice)))
-
-(defun mastodon--url-at-point ()
- "`thing-at-point' provider function."
- (get-text-property (point) 'shr-url))
-
-(defun mastodon-mode-hook-fun ()
- "Function to add to `mastodon-mode-hook'."
- (when (and mastodon-use-emojify
- (require 'emojify nil :noerror))
- (emojify-mode t)
- (when mastodon-toot--enable-custom-instance-emoji
- (mastodon-toot-enable-custom-emoji)))
- (mastodon-profile--fetch-server-account-settings)
- (when (and mastodon-tl--highlight-current-toot
- (fboundp #'cursor-face-highlight-mode))
- (cursor-face-highlight-mode)) ; 29.1
- ;; make `thing-at-point' functions work:
- (setq-local thing-at-point-provider-alist
- (append thing-at-point-provider-alist
- '((url . mastodon--url-at-point)))))
-
-;;;###autoload
-(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
-
-(define-derived-mode mastodon-mode special-mode "Mastodon"
- "Major mode for fediverse services using the Mastodon API."
- (read-only-mode 1))
-
-(provide 'mastodon)
-;;; mastodon.el ends here
+++ /dev/null
-This is mastodon.info, produced by makeinfo version 6.8 from
-mastodon.texi.
-
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Mastodon: (mastodon). Client for fediverse services using the Mastodon API.
-END-INFO-DIR-ENTRY
-
-\1f
-File: mastodon.info, Node: Top, Next: README, Up: (dir)
-
-A Mastodon client
-*****************
-
-* Menu:
-
-* README::
-
-— The Detailed Node Listing —
-
-README
-
-* Installation::
-* Usage::
-* Dependencies::
-* Network compatibility::
-* Contributing::
-* Supporting ‘mastodon.el’: Supporting mastodonel.
-* Contributors::
-* Screenshots::
-
-Installation
-
-* ELPA::
-* MELPA::
-* Repo::
-* Emoji::
-* Discover::
-
-Usage
-
-* Logging in to your instance::
-* Timelines::
-* Composing toots::
-* Other commands and account settings::
-* Notifications::
-* Customization::
-* Commands and variables index::
-* Packages related to ‘mastodon.el’: Packages related to mastodonel.
-* Live-updating timelines mastodon-async-mode::
-* Translating toots::
-* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel.
-
-Contributing
-
-* Bug reports::
-* Fixes and features::
-* Coding style::
-
-
-\1f
-File: mastodon.info, Node: README, Prev: Top, Up: Top
-
-1 README
-********
-
-‘mastodon.el’ is an Emacs client for the ActivityPub social networks
-that implement the Mastodon API. For info see joinmastodon.org
-(https://joinmastodon.org/).
-
- NB: ‘mastodon.el’ now ships this readme as an .info file, so if you
-have it installed you should be able to browse this readme inside emacs.
-‘C-h i’ for info, then ‘m masto RET’ should load it for you.
-
-* Menu:
-
-* Installation::
-* Usage::
-* Dependencies::
-* Network compatibility::
-* Contributing::
-* Supporting ‘mastodon.el’: Supporting mastodonel.
-* Contributors::
-* Screenshots::
-
-\1f
-File: mastodon.info, Node: Installation, Next: Usage, Up: README
-
-1.1 Installation
-================
-
-You can install ‘mastodon.el’ from ELPA, MELPA, or directly from this
-repo. It is also available as a GUIX package.
-
-* Menu:
-
-* ELPA::
-* MELPA::
-* Repo::
-* Emoji::
-* Discover::
-
-\1f
-File: mastodon.info, Node: ELPA, Next: MELPA, Up: Installation
-
-1.1.1 ELPA
-----------
-
-You should be able to directly install with:
-
- ‘M-x package-refresh-contents RET’
-
- ‘M-x package-install RET mastodon RET’
-
-\1f
-File: mastodon.info, Node: MELPA, Next: Repo, Prev: ELPA, Up: Installation
-
-1.1.2 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’
-
-\1f
-File: mastodon.info, Node: Repo, Next: Emoji, Prev: MELPA, Up: Installation
-
-1.1.3 Repo
-----------
-
-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 28.1. But if you are running an
-older version it shouldn’t be very hard to get it working.
-
-\1f
-File: mastodon.info, Node: Emoji, Next: Discover, Prev: Repo, Up: Installation
-
-1.1.4 Emoji
------------
-
-Since Emacs 28, it has builtin emoji support with ‘emoji.el’. If you
-prefer to use Emojify (https://github.com/iqbalansari/emacs-emojify),
-‘require’ it and set ‘mastodon-use-emojify’ to non-nil to display emoji
-in timelines and to use it when composing toots. ‘Emoji.el’ is the
-better option, but for now only ‘emojify’ supports downloading and using
-custom emoji from your instance. From personal experience, ‘emojify’
-also tends to result in less TOFU.
-
-\1f
-File: mastodon.info, Node: Discover, Prev: Emoji, Up: Installation
-
-1.1.5 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))
-
-\1f
-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::
-* Notifications::
-* Customization::
-* Commands and variables index::
-* Packages related to ‘mastodon.el’: Packages related to mastodonel.
-* Live-updating timelines mastodon-async-mode::
-* Translating toots::
-* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel.
-
-\1f
-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_userNOSPAMsocial.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, call ‘(mastodon-forget-all-logins)’, restart
-Emacs and follow the steps again.
-
- 1. encrypted access tokens (from 2.0.0)
-
- By default, user access tokens are now stored in the user’s auth
- source file (typically ‘~/.authinfo.gpg’, check the value of
- ‘auth-sources’). When you first update to 2.0.0, or if you
- encounter issues due to old credentials, call
- ‘(mastodon-forget-all-logins)’ to remove the old mastodon.el
- plstore, and then authenticate again. If you don’t want to use the
- auth source file, set ‘mastodon-auth-use-auth-source’ to nil.
- Entries will instead be stored encrypted in
- ‘mastodon-client--token-file’, a plstore.
-
- If for some reason you reauthenticate, you’ll need to either remove
- the entry in your auth sources file, or manually update the token
- in it after doing so, as mastodon.el is unable to reliably update
- (or even remove) entries.
-
- The format for a mastodon.el auth source entry is as follows:
-
- ‘machine INSTANCE login USERNAME password AUTHTOKEN’
-
- with the token being what you copy from the browser when
- authenticating. If you have ‘auth-source-save-behavior’ set to
- nil, you’ll also need to add such an entry manually.
-
- Finally, if you find you’re asked for your key passphrase too often
- while authenticating, consider setting ‘epa-file-encrypt-to’ (for
- auth-source encryption) and ‘plstore-encrypt-to’ (for plstore
- encryption) to your preferred key ID.
-
-\1f
-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
-
- For a full list of commands and variables, see mastodon-index.org
- (mastodon-index.org).
-
- Key Action
- -----------------------------------------------------------------------------------------------------------
- *Help*
- ‘?’ Show discover menu of all bindings, if ‘discover’ is available
- *Timeline actions*
- ‘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 (1 prefix arg: hide-replies, 2 prefix args: media only)
- ‘H’ Open home timeline (1 prefix arg: hide-replies)
- ‘L’ Open local timeline (1 prefix arg: hide-replies, 2 prefix args: media only)
- ‘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 followed tags and load a tag timeline
- ‘C-:’ view timeline of all followed tags
- ‘,’ view favouriters of toot at point
- ‘.’ view boosters of toot at point
- ‘/’ switch between mastodon buffers
- ‘\’ prompt for an instance domain and view its local timeline (if poss)
- ‘Z’ report user/toot at point to instances moderators
- *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
- ‘S-:’ view profile/account settings transient menu
- *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
- ‘!’ toggle folding of toot at point
- (‘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, statuses without boosts, followers, and following
- ‘mastodon-profile--add-account-to-list’ (see lists view)
- *Notifications view*
- ‘a’, ‘j’ accept/reject follow request
- ‘C-k’ clear notification at point
- ‘C-c C-c’ cycle between notification types
- 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
- --------------------------------------------
- ‘(🔁)’ (or I boosted this toot
- ‘(B)’)
- ‘(⭐)’ (or I favourited this toot
- ‘(F)’)
- ‘(🔖)’ (or I bookmarked this toot
- ‘(K)’)
-
-\1f
-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) opens 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. Further keybindings
-are displayed in the buffer, and in the following subsection.
-
- Replies preserve visibility status/content warnings, and include
-boosters by default. If the region is active when you start a reply, it
-will be yanked into the compose buffer prefixed with ‘>’ to form a rough
-reply quote.
-
- Server’s max toot length, with running char count, 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’).
-
- If you want to view some of the toot being replied to in the compose
-buffer, set ‘mastodon-toot-display-orig-in-reply-buffer’ to non-nil.
-
- 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’ Insert emoji
- ‘C-c C-p’ Create a poll
- ‘C-c C-o’ Cancel poll
- ‘C-c C-l’ Set toot language
- ‘C-c C-s’ Schedule toot
-
- 2. Autocompletion of mentions, tags and emoji
-
- Autocompletion of mentions, tags, and emojis is provided by
- ‘completion-at-point-functions’ (capf) backends.
- ‘mastodon-toot--enable-completion’ is enabled by default.
-
- To trigger completion, type a prefix followed by a few letters, ‘@’
- for mentions, ‘#’ for tags, and ‘:’ for emoji (for now this only
- works when using ‘emojify.el’).
-
- 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.)
-
- If you don’t run ‘company’ and want immediate, keyless completion,
- you’ll need to have another completion engine running that handles
- capfs. A common combination is ‘consult’ and ‘corfu’.
-
- 3. 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.
-
-\1f
-File: mastodon.info, Node: Other commands and account settings, Next: Notifications, 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 a ‘mastodon.el’ buffer:
- • ‘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-search--trending-statuses’: View a list of trending
- statuses on your instance.
- • ‘mastodon-search--trending-links’: View a list of trending links on
- your instance (+ click through to a timeline of posts featuring a
- given link)
-
- • ‘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-tl--followed-tags-timeline’: View a timeline of all your
- followed tags.
- • ‘mastodon-tl--some-followed-tags-timleine’: View a timeline of
- multiple tags, from your followed tags or any other.
-
- • ‘mastodon-switch-to-buffer’: switch between mastodon buffers.
-
- • ‘mastodon-tl--get-remote-local-timeline’: View a local timeline of
- a remote instance.
- • ‘mastodon-tl--remote-tag-timeline’: View a tag timeline on a remote
- instance.
-
- • ‘mastodon-user-settings’: Launch a transient menu to update various
- account settings.
-
-\1f
-File: mastodon.info, Node: Notifications, Next: Customization, Prev: Other commands and account settings, Up: Usage
-
-1.2.5 Notifications
--------------------
-
-Mastodon from 4.3 supports grouped notifications. These are implemented
-by ‘mastodon.el’ but disabled by default out of consideration to users
-on instances that don’t support them. If you are on an instance that
-implements grouped notifications, set ‘mastodon-group-notifications’ to
-‘t’ to enable them.
-
-\1f
-File: mastodon.info, Node: Customization, Next: Commands and variables index, Prev: Notifications, Up: Usage
-
-1.2.6 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
-
- • Nofitication options:
- • Display user’s profile note in follow requests
- • Group notifications
-
-\1f
-File: mastodon.info, Node: Commands and variables index, Next: Packages related to mastodonel, Prev: Customization, Up: Usage
-
-1.2.7 Commands and variables index
-----------------------------------
-
-An index of all user-facing commands and custom variables is available
-here: mastodon-index.org (mastodon-index.org).
-
- You can also hit ‘?’ in any ‘mastodon.el’ buffer to see the available
-bindings, or run ‘M-X’ (upper-case ‘X’) to view all commands in the
-buffer with completion, and call one.
-
-\1f
-File: mastodon.info, Node: Packages related to mastodonel, Next: Live-updating timelines mastodon-async-mode, Prev: Commands and variables index, Up: Usage
-
-1.2.8 Packages related to ‘mastodon.el’
----------------------------------------
-
- 1. Alternative timeline layout
-
- The incomparable Nicholas Rougier has written an alternative
- timeline layout for ‘mastodon.el’.
-
- The repo is at mastodon-alt
- (https://github.com/rougier/mastodon-alt).
-
- 2. Org links, archive search
-
- toot-suite (https://codeberg.org/chrmoe/toot-suite) implements an
- org link type for fediverse posts, and also provides a way to
- browse an offline archive of your account.
-
- 3. Mastodon hydra
-
- A user made a hydra for handling basic ‘mastodon.el’ commands.
- It’s available at
- <https://holgerschurig.github.io/en/emacs-mastodon-hydra/>.
-
- 4. Narrow to timeline item
-
- A simple code snippet to enable narrowing to current item in
- timelines:
- <http://takeonrules.com/2024/10/31/hacking-on-mastodon-emacs-package-to-narrow-viewing/>
-
- 5. Sachac’s config goodies
-
- The incomparable sachac has a bunch of ‘mastodon.el’ extensions and
- goodies in their literate config, available here:
- <https://sachachua.com/dotemacs/index.html#mastodon>.
-
-\1f
-File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Packages related to mastodonel, Up: Usage
-
-1.2.9 Live-updating timelines: ‘mastodon-async-mode’
-----------------------------------------------------
-
-(code taken from mastodon-future
-(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-’.
-
-\1f
-File: mastodon.info, Node: Translating toots, Next: Bookmarks and mastodonel, Prev: Live-updating timelines mastodon-async-mode, Up: Usage
-
-1.2.10 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
-lingva.ml (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 'item-json)))
- (if toot
- (lingva-translate nil (mastodon-tl--content toot))
- (message "No toot to translate?"))))
-
-\1f
-File: mastodon.info, Node: Bookmarks and mastodonel, Prev: Translating toots, Up: Usage
-
-1.2.11 Bookmarks and ‘mastodon.el’
-----------------------------------
-
-‘mastodon.el’ implements a basic bookmark record and handler.
-Currently, this means that you can bookmark a post item and later load
-it in thread view. This could be expanded to any item with an id, but
-probably not to things like timeline views. If you want to be able to
-bookmark something, open an issue and ask, as it’s trivial to expand the
-bookmarking code.
-
-\1f
-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, emacs-request
- (https://github.com/tkf/emacs-request))
- • ‘persist’ (for storing some settings across sessions, persist
- (https://elpa.gnu.org/packages/persist.html))
- • ‘tp.el’ (for transient menus, tp.el
- (https://codeberg.org/martianh/tp.el))
-
- Optional dependencies (install yourself, ‘mastodon.el’ can use them):
- • ‘emojify’ to use custom emoji (else we use builtin ‘emoji.el’)
- • ‘mpv’ and ‘mpv.el’ for viewing videos and gifs
- • ‘lingva.el’ for translating toots
-
-\1f
-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 (pleroma.social (https://pleroma.social/))
- • Akkoma (akkoma.social (https://akkoma.social/))
- • Gotosocial (gotosocial.org (https://gotosocial.org/))
- • Sharkey (joinsharkey.org (https://joinsharkey.org))
-
- It does not support the non-Mastodon API servers Misskey (misskey.io
-(https://misskey.io/)), Firefish (joinfirefish.org
-(https://joinfirefish.org/), formerly Calkey) and Friendica, but it
-should fully support displaying and interacting with posts and users on
-those platforms.
-
- If you attempt to use ‘mastodon.el’ with a server and run into
-problems, feel free to open an issue.
-
-\1f
-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!
-
- If you prefer emailing patches to the process described below, feel
-free to send them on. Ideally they’d be patches that can be applied
-with ‘git am’, if you want to actually contribute a commit.
-
-* Menu:
-
-* Bug reports::
-* Fixes and features::
-* Coding style::
-
-\1f
-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. Else 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.
-
-\1f
-File: mastodon.info, Node: Fixes and features, Next: Coding style, Prev: Bug reports, Up: Contributing
-
-1.5.2 Fixes and features
-------------------------
-
- 1. Install Cask
- (https://cask.readthedocs.io/en/latest/guide/installation.html) if
- you don’t already have it installed
- 2. Create an issue (https://codeberg.org/martianh/mastodon.el/issues)
- detailing what you’d like to do.
- 3. Fork the repository and create a branch off of ‘develop’.
- 4. Run the tests (with ‘make tests’) and ensure that your code doesn’t
- break any of them.
- 5. Create a pull request (to develop) referencing the issue created in
- step 2.
-
-\1f
-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).
-
-\1f
-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).
-
- I also accept support via liberapay:
-
- If you would prefer a different payment method, please write to me at
-<mousebot {at} disroot.org> and I can provide IBAN or other bank account
-details.
-
- I don’t have a tech worker’s income, so even a small tip would help
-out.
-
-\1f
-File: mastodon.info, Node: Contributors, Next: Screenshots, 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>
-
-\1f
-File: mastodon.info, Node: Screenshots, Prev: Contributors, Up: README
-
-1.8 Screenshots
-===============
-
-Here’s a (federated) timeline:
-
-\0\b[image src="screenshot-tl.png"\0\b]
-
-
- Here’s a notifcations view plus a compose buffer:
-
-\0\b[image src="screenshot-notifs+compose.png"\0\b]
-
-
- Here’s a user settings transient (active values green, current server
-values commented and, if a boolean, underlined):
-
-\0\b[image src="screenshot-transient-1.jpg"\0\b]
-
-
- Here’s a user profile fields transient (changed fields green, current
-server values commented):
-
-\0\b[image src="screenshot-transient-2.jpg"\0\b]
-
-
-
-\1f
-Tag Table:
-Node: Top\7f219
-Node: README\7f1083
-Node: Installation\7f1732
-Node: ELPA\7f2021
-Node: MELPA\7f2249
-Node: Repo\7f2629
-Node: Emoji\7f3122
-Node: Discover\7f3716
-Node: Usage\7f4268
-Node: Logging in to your instance\7f4770
-Ref: encrypted access tokens (from 200)\7f5742
-Node: Timelines\7f7200
-Ref: Keybindings\7f7675
-Ref: Toot byline legend\7f12657
-Node: Composing toots\7f12966
-Ref: Keybindings (1)\7f14518
-Ref: Autocompletion of mentions tags and emoji\7f15073
-Ref: Draft toots\7f15998
-Node: Other commands and account settings\7f16469
-Node: Notifications\7f19144
-Node: Customization\7f19629
-Node: Commands and variables index\7f20517
-Node: Packages related to mastodonel\7f21036
-Ref: Alternative timeline layout\7f21289
-Ref: Org links archive search\7f21516
-Ref: Mastodon hydra\7f21735
-Ref: Narrow to timeline item\7f21919
-Ref: Sachac's config goodies\7f22126
-Node: Live-updating timelines mastodon-async-mode\7f22345
-Node: Translating toots\7f23200
-Node: Bookmarks and mastodonel\7f24383
-Node: Dependencies\7f24925
-Node: Network compatibility\7f25711
-Node: Contributing\7f26652
-Node: Bug reports\7f27148
-Node: Fixes and features\7f28059
-Node: Coding style\7f28722
-Node: Supporting mastodonel\7f29346
-Node: Contributors\7f29947
-Node: Screenshots\7f30382
-\1f
-End Tag Table
-
-\1f
-Local Variables:
-coding: utf-8
-End:
--- /dev/null
+mastodon.el is a client for fediverse services that implement the Mastodon
+API. See <https://github.com/mastodon/mastodon>.
+
+For set up and usage details, see the Info documentation, or the readme
+file at <https://codeberg.org/martianh/mastodon.el>.
--- /dev/null
+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.
+\1f
+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 fediverse services using the
+ Mastodon API.
--- /dev/null
+;;; mastodon-async.el --- Async streaming functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Alex J. Griffith
+;; Author: Alex J. Griffith <griffitajNOSPAMgmail.com>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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:
+
+;; Rework sync code so it does not mess up the async-buffer
+
+;;; Code:
+
+(require 'mastodon-tl)
+(require 'json)
+(require 'url-http)
+
+(defvar url-http-end-of-headers)
+
+(autoload 'mastodon-auth--access-token "mastodon-auth")
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-mode "mastodon")
+(autoload 'mastodon-notifications--timeline "mastodon-notifications")
+(autoload 'mastodon-tl--timeline "mastodon-tl")
+
+(defgroup mastodon-async nil
+ "An async module for mastodon streams."
+ :prefix "mastodon-async-"
+ :group 'external)
+
+;;;###autoload
+(define-minor-mode mastodon-async-mode
+ "Async Mastodon."
+ :lighter " MasA")
+
+(defvar mastodon-instance-url)
+
+(defvar mastodon-tl--enable-relative-timestamps)
+(defvar mastodon-tl--display-media-p)
+(defvar mastodon-tl--buffer-spec)
+
+(defvar-local mastodon-async--queue "" ;;"*mastodon-async-queue*"
+ "The intermediate queue buffer name.")
+
+(defvar-local mastodon-async--buffer "" ;;"*mastodon-async-buffer*"
+ "User facing output buffer name.")
+
+(defvar-local mastodon-async--http-buffer "" ;;""
+ "Buffer variable bound to http output.")
+
+(defun mastodon-async--display-http ()
+ "Display the async HTTP input buffer."
+ (display-buffer mastodon-async--http-buffer))
+
+(defun mastodon-async--display-buffer ()
+ "Display the async user facing buffer."
+ (interactive)
+ (display-buffer mastodon-async--buffer))
+
+(defun mastodon-async--display-queue ()
+ "Display the async queue buffer."
+ (display-buffer mastodon-async--queue))
+
+(defun mastodon-async--stop-http ()
+ "Stop the http processs and close the async and http buffer."
+ (interactive)
+ (let ((inhibit-read-only t))
+ (stop-process (get-buffer-process mastodon-async--http-buffer))
+ (delete-process (get-buffer-process mastodon-async--http-buffer))
+ (kill-buffer mastodon-async--http-buffer)
+ (setq mastodon-async--http-buffer "")
+ (when (not (string= "" mastodon-async--queue)) ; error handle on kill async buffer
+ (kill-buffer mastodon-async--queue))))
+
+(defun mastodon-async--stream-notifications ()
+ "Open a stream of user notifications."
+ (interactive)
+ (mastodon-async--mastodon
+ "user"
+ "home"
+ "notifications"
+ 'mastodon-async--process-queue-string-notifications))
+
+(defun mastodon-async--stream-home ()
+ "Open a stream of the home timeline."
+ (interactive)
+ (mastodon-async--mastodon
+ "user"
+ "home"
+ "home"
+ 'mastodon-async--process-queue-string))
+
+(defun mastodon-async--stream-federated ()
+ "Open a stream of Federated."
+ (interactive)
+ (mastodon-async--mastodon
+ "public"
+ "public"
+ "federated"
+ 'mastodon-async--process-queue-string))
+
+(defun mastodon-async--stream-local ()
+ "Open a stream of Local."
+ (interactive)
+ ;; Need to add another layer of filtering for this to work
+ ;; apparently it the local flag does not work
+ (mastodon-async--mastodon
+ "public"
+ "public?local=true"
+ "local"
+ 'mastodon-async--process-queue-local-string))
+
+(defun mastodon-async--mastodon (endpoint timeline name filter)
+ "Make sure that the previous async process has been closed.
+Then start an async stream at ENDPOINT filtering toots
+using FILTER.
+TIMELINE is a specific target, such as federated or home.
+NAME is the center portion of the buffer name for
+*mastodon-async-buffer and *mastodon-async-queue."
+ (ignore timeline) ;; TODO: figure out what this is meant to be used for
+ (let ((buffer (mastodon-async--start-process
+ endpoint filter name)))
+ (with-current-buffer buffer
+ (mastodon-async--display-buffer)
+ (goto-char (point-max))
+ (goto-char 1))))
+
+(defun mastodon-async--get (url callback)
+ "An async GET request to URL with CALLBACK."
+ (let ((url-request-method "GET")
+ (url-request-extra-headers
+ `(("Authorization" .
+ ,(concat
+ "Bearer "
+ (mastodon-auth--access-token))))))
+ (url-retrieve url callback)))
+
+(defun mastodon-async--set-http-buffer (buffer http-buffer)
+ "Initialize for BUFFER a local variable `mastodon-async--http-buffer'.
+HTTP-BUFFER is the initializing value. Use this funcion if HTTP-BUFFER
+is not known when `mastodon-async--setup-buffer' is called."
+ (with-current-buffer (get-buffer-create buffer)
+ (setq mastodon-async--http-buffer http-buffer)))
+
+(defun mastodon-async--set-local-variables (buffer
+ http-buffer
+ buffer-name
+ queue-name)
+ "Set local variables for BUFFER, HTTP-BUFFER, BUFFER-NAME, and QUEUE-NAME."
+ (with-current-buffer (get-buffer-create buffer)
+ (let ((value mastodon-instance-url))
+ (make-local-variable 'mastodon-instance-url)
+ (setq-local mastodon-instance-url value))
+ (setq mastodon-async--http-buffer http-buffer)
+ (setq mastodon-async--buffer buffer-name)
+ (setq mastodon-async--queue queue-name)))
+
+(defun mastodon-async--setup-http (http-buffer name)
+ "Add local variables to HTTP-BUFFER.
+NAME is used to generate the display buffer and the queue."
+ (let ((queue-name (concat " *mastodon-async-queue-" name "-"
+ mastodon-instance-url "*"))
+ (buffer-name (concat "*mastodon-async-display-" name "-"
+ mastodon-instance-url "*")))
+ (mastodon-async--set-local-variables http-buffer http-buffer
+ buffer-name queue-name)))
+
+(defun mastodon-async--setup-queue (http-buffer name)
+ "Set up HTTP-BUFFER buffer for the async queue.
+NAME is used to generate the display buffer and the queue."
+ (let ((queue-name (concat " *mastodon-async-queue-" name "-"
+ mastodon-instance-url "*"))
+ (buffer-name(concat "*mastodon-async-display-" name "-"
+ mastodon-instance-url "*")))
+ (mastodon-async--set-local-variables queue-name http-buffer
+ buffer-name queue-name)
+ queue-name))
+
+(defun mastodon-async--setup-buffer (http-buffer name endpoint)
+ "Set up the buffer timeline like `mastodon-tl--init'.
+HTTP-BUFFER the name of the http-buffer, if unknown, set to...
+NAME is the name of the stream for the buffer name.
+ENDPOINT is the endpoint for the stream and timeline."
+ (let ((queue-name (concat " *mastodon-async-queue-" name "-"
+ mastodon-instance-url "*"))
+ (buffer-name (concat "*mastodon-async-display-" name "-"
+ mastodon-instance-url "*"))
+ ;; if user stream, we need "timelines/home" not "timelines/user"
+ ;; if notifs, we need "notifications" not "timelines/notifications"
+ (endpoint (cond
+ ((string= name "notifications") "notifications")
+ ((string= name "home") "timelines/home")
+ (t (format "timelines/%s" endpoint)))))
+ (mastodon-async--set-local-variables buffer-name http-buffer
+ buffer-name queue-name)
+ ;; Similar to timeline init.
+ (with-current-buffer (get-buffer-create buffer-name)
+ (setq inhibit-read-only t) ; for home timeline?
+ (make-local-variable 'mastodon-tl--enable-relative-timestamps)
+ (make-local-variable 'mastodon-tl--display-media-p)
+ (message (mastodon-http--api endpoint))
+ (if (string= name "notifications")
+ (mastodon-notifications--timeline
+ (mastodon-http--get-json
+ (mastodon-http--api "notifications")))
+ (mastodon-tl--timeline (mastodon-http--get-json
+ (mastodon-http--api endpoint))))
+ (mastodon-mode)
+ (mastodon-tl--set-buffer-spec buffer-name
+ endpoint
+ (if (string= 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))))
+
+(defun mastodon-async--start-process (endpoint filter &optional name)
+ "Start an async mastodon stream at ENDPOINT.
+Filter the toots using FILTER.
+NAME is used for the queue and display buffer."
+ (let* ((stream (concat "streaming/" endpoint))
+ (async-queue (mastodon-async--setup-queue "" (or name stream)))
+ (async-buffer (mastodon-async--setup-buffer "" (or name stream) endpoint))
+ (http-buffer (mastodon-async--get
+ (mastodon-http--api stream)
+ (lambda (status)
+ (ignore status)
+ (message "HTTP SOURCE CLOSED")))))
+ (mastodon-async--setup-http http-buffer (or name stream))
+ (mastodon-async--set-http-buffer async-buffer http-buffer)
+ (mastodon-async--set-http-buffer async-queue http-buffer)
+ (set-process-filter (get-buffer-process http-buffer)
+ (mastodon-async--http-hook filter))
+ http-buffer))
+
+(defun mastodon-async--http-hook (filter)
+ "Return a lambda with a custom FILTER for processing toots."
+ (let ((filter filter))
+ (lambda (proc data)
+ (with-current-buffer (process-buffer proc)
+ (let* ((string
+ (mastodon-async--stream-filter
+ (mastodon-async--http-layer proc data)))
+ (queue-string (mastodon-async--cycle-queue string)))
+ (when queue-string
+ (mastodon-async--output-toot
+ (funcall filter queue-string))))))))
+
+(defun mastodon-async--process-queue-string (string)
+ "Parse the output STRING of the queue buffer, returning only update events."
+ (let ((split-strings (split-string string "\n" t)))
+ (when split-strings ; do nothing if we get nothing; just postpones the error
+ (let ((event-type (replace-regexp-in-string
+ "^event: " ""
+ (car split-strings)))
+ (data (replace-regexp-in-string
+ "^data: " "" (cadr split-strings))))
+ (when (string= "update" event-type)
+ ;; in some casses the data is not fully formed
+ ;; for now return nil if malformed using `ignore-errors'
+ (ignore-errors (json-read-from-string data)))))))
+
+(defun mastodon-async--process-queue-string-notifications (string)
+ "Parse the output STRING of the queue buffer, returning only notification events."
+ ;; NB notification events in streams include follow requests
+ (let* ((split-strings (split-string string "\n" t))
+ (event-type (replace-regexp-in-string
+ "^event: " ""
+ (car split-strings)))
+ (data (replace-regexp-in-string
+ "^data: " "" (cadr split-strings))))
+ (when (string= "notification" event-type)
+ ;; in some casses the data is not fully formed
+ ;; for now return nil if malformed using `ignore-errors'
+ (ignore-errors (json-read-from-string data)))))
+
+(defun mastodon-async--process-queue-local-string (string)
+ "Use STRING to limit the public endpoint to displaying local steams only."
+ (let ((json (mastodon-async--process-queue-string string)))
+ (when json
+ (when (mastodon-async--account-local-p json)
+ json))))
+
+(defun mastodon-async--account-local-p (json)
+ "Test JSON to see if account is local."
+ (not (string-match-p
+ "@"
+ (alist-get 'acct (alist-get 'account json)))))
+
+(defun mastodon-async--output-toot (toot)
+ "Process TOOT and prepend it to the async user-facing buffer."
+ (if (not (bufferp (get-buffer mastodon-async--buffer)))
+ (mastodon-async--stop-http)
+ (when toot
+ (with-current-buffer mastodon-async--buffer
+ (let* ((inhibit-read-only t)
+ (old-max (point-max))
+ (previous (point))
+ (mastodon-tl--enable-relative-timestamps t)
+ (mastodon-tl--display-media-p t))
+ (goto-char (point-min))
+ (if (equal (buffer-name)
+ (concat "*mastodon-async-display-notifications-"
+ mastodon-instance-url "*"))
+ (mastodon-notifications--timeline (list toot))
+ (mastodon-tl--timeline (list toot)))
+ (if (eq previous 1)
+ (goto-char 1)
+ (goto-char (+ previous (- (point-max) old-max)))))))))
+
+(defun mastodon-async--cycle-queue (string)
+ "Append the most recent STRING from http buffer to queue buffer.
+Then determine if a full message has been recived. If so return it.
+Full messages are seperated by two newlines"
+ (with-current-buffer mastodon-async--queue
+ (goto-char (max-char))
+ (insert (decode-coding-string string 'utf-8))
+ (goto-char 0)
+ (let ((next (re-search-forward "\n\n" nil t)))
+ (when next
+ (let ((return-string (buffer-substring 1 next))
+ (inhibit-read-only t))
+ (delete-region 1 next)
+ return-string)))))
+
+(defun mastodon-async--http-layer (proc data)
+ "Passes PROC and DATA to ‘url-http-generic-filter’.
+It then processes its output."
+ (with-current-buffer (process-buffer proc)
+ (let ((start (max 1 (- (point-max) 2))))
+ (url-http-generic-filter proc data)
+ (when (> url-http-end-of-headers start)
+ (setq start url-http-end-of-headers))
+ (let ((end (- (point-max) 2)))
+ (buffer-substring start end)))))
+
+(defun mastodon-async--stream-filter (string)
+ "Remove comments from STRING."
+ (replace-regexp-in-string "^:.*\n" "" string))
+
+(provide 'mastodon-async)
+;;; mastodon-async.el ends here
--- /dev/null
+;;; mastodon-auth.el --- Auth functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2021 Abhiseck Paira <abhiseckpairaNOSPAMdisroot.org>
+;; Copyright (C) 2025 Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-auth.el supports authorizing and authenticating with Mastodon.
+
+;;; Code:
+
+(require 'plstore)
+(require 'auth-source)
+(require 'json)
+(require 'url)
+
+(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--concat-params-to-url "mastodon-http")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-http--post "mastodon-http")
+(autoload 'mastodon-return-credential-account "mastodon")
+(autoload 'mastodon-client--general-read "mastodon-client")
+(autoload 'mastodon-client--token-file "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-use-auth-source t
+ "Whether to use auth sources for user credentials.
+If t, save and read user access token in the user's auth source
+file (see `auth-sources'). If nil, use `mastodon-client--token-file'
+instead.
+If you change the value of this variable, call
+`mastodon-forget-all-logins' and log in again.
+If for some reason you generate a new token, you'll have to update your
+auth souce file manually, or at least remove the entry and authenticate
+again, as auth-source.el only provides unreliable tools for updating
+entries."
+ :type 'boolean)
+
+(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.")
+
+(defvar mastodon-auth--acct-alist nil
+ "Alist of account accts (name@domain) keyed by instance url.")
+
+(defvar mastodon-auth--user-unaware
+ " ** MASTODON.EL - NOTICE **
+
+User variables not set: mastodon.el requires that you set both
+`mastodon-active-user' and `mastodon-instance-url' in your init file.
+
+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.
+")
+
+(defun mastodon-auth--get-browser-login-url ()
+ "Return properly formed browser login url."
+ (let ((client-id (plist-get (mastodon-client) :client_id)))
+ (if (not client-id)
+ (error "Failed to set up client id")
+ (mastodon-http--concat-params-to-url
+ (concat mastodon-instance-url "/oauth/authorize/")
+ `(("response_type" . "code")
+ ("redirect_uri" . ,mastodon-client-redirect-uri)
+ ("scope" . ,mastodon-client-scopes)
+ ("client_id" . ,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.
+By default 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 'below)
+ 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))
+ (select-enable-clipboard t)
+ authorization-code)
+ (kill-new url)
+ (message "%s" url)
+ (setq authorization-code
+ (mastodon-auth--show-notice mastodon-auth--explanation
+ "*mastodon-notice*"
+ "Authorization Code: "))
+ authorization-code))
+
+(defun mastodon-auth--generate-token ()
+ "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."
+ (with-current-buffer (mastodon-auth--generate-token)
+ (goto-char (point-min))
+ (re-search-forward "^$" nil 'move)
+ (let ((json-object-type 'plist)
+ (json-key-type 'keyword)
+ (json-array-type 'vector)
+ (json-string (buffer-substring-no-properties (point) (point-max))))
+ (json-read-from-string json-string))))
+
+(defun mastodon-auth--plstore-token-check (&optional auth-source)
+ "Signal an error if plstore contains unencrypted access-token.
+If AUTH-SOURCE, and if `mastodon-auth-use-auth-source' is non-nil,
+return non-nil if it contains any access token.
+Used to help users switch to the new encrypted auth token flow."
+ ;; FIXME: is it poss to move this plstore read to have one less read?
+ ;; e.g. inside of `mastodon-client--active-user'? the issue is that
+ ;; ideally we want to test "user-" entry, even if fetching "active-user"
+ ;; entry, so we would have to re-do the plstore read functions.
+ (when
+ (mastodon-auth--plstore-access-token-member auth-source)
+ (if auth-source
+ (user-error "Auth source storage of tokens is enabled,\
+ but there is also an access token in your plstore.\
+ If you're seeing this message after updating,\
+ call `mastodon-forget-all-logins', and try again.
+ If you don't want to use auth sources,\
+ also set `mastodon-auth-use-auth-source' to nil.\
+ If this message is in error, contact us on the mastodon.el repo")
+ (user-error "Unencrypted access token in your plstore.\
+ If you're seeing this message after updating,\
+ call `mastodon-forget-all-logins', and log in again.
+ If this message is in error, contact us on the mastodon.el repo"))))
+
+(defun mastodon-auth--plstore-access-token-member (&optional auth-source)
+ "Return non-nil if the user entry of the plstore contains :access_token.
+If AUTH-SOURCE, also check if it contains :secret-access_token."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (name (concat "user-" (mastodon-client--form-user-from-vars)))
+ ;; get alist like plstore.el does, so that keys will display with
+ ;; ":secret-" prefix if encrypted:
+ (alist (assoc name (plstore--get-merged-alist plstore))))
+ (if (and auth-source mastodon-auth-use-auth-source)
+ (or (member :access_token alist)
+ (member :secret-access_token alist))
+ (member :access_token alist))))
+
+(defun mastodon-auth--access-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.
+ (alist-get mastodon-instance-url
+ mastodon-auth--token-alist nil nil #'string=))
+ ;; if auth source enabled, but we have an access token in plstore,
+ ;; error out and tell user to remove plstore and start over or disable
+ ;; auth source:
+ ((mastodon-auth--plstore-token-check))
+ ((plist-get (mastodon-client--active-user) :access_token)
+ ;; user variables need to be read from plstore active-user entry.
+ (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 #'string=))
+ ((null mastodon-active-user)
+ ;; user not aware of 2FA-related changes and has not set
+ ;; `mastodon-active-user'. Make user aware and error out.
+ (mastodon-auth--show-notice mastodon-auth--user-unaware
+ "*mastodon-notice*")
+ (user-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'.
+The token is returned by `mastodon-auth--get-token'.
+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)))
+ (`(:error ,class :error_description ,error)
+ (error "Mastodon-auth--access-token: %s: %s" class error))
+ (_ (error "Unknown response from mastodon-auth--get-token!"))))
+
+(defun mastodon-auth-source-get (user host &optional token create)
+ "Fetch an auth source token, searching by USER and HOST.
+If CREATE, use TOKEN or prompt for it, and save it if there is no such entry.
+Return a list of user, password/secret, and the item's save-function."
+ (let* ((auth-source-creation-prompts
+ '((secret . "%u access token: ")))
+ (source
+ (car
+ (auth-source-search :host host :user user
+ :require '(:user :secret)
+ :secret (if token token nil)
+ ;; "create" alone doesn't work here!:
+ :create (if create t nil)))))
+ (when source
+ (let ((creds
+ `(,(plist-get source :user)
+ ,(auth-info-password source)
+ ,(plist-get source :save-function))))
+ (when create ;; call save function:
+ (when (functionp (nth 2 creds))
+ (funcall (nth 2 creds))))
+ creds))))
+
+(defun mastodon-auth-source-token (url handle &optional token create)
+ "Parse URL, search auth sources with it, user HANDLE and TOKEN.
+Calls `mastodon-auth-source-get', returns only the token.
+If CREATE, create an entry is none is found."
+ (let ((host (url-host
+ (url-generic-parse-url url)))
+ (username (car (split-string handle "@"))))
+ (nth 1
+ (mastodon-auth-source-get username host token create))))
+
+(defun mastodon-auth--get-account-name ()
+ "Request user credentials and return an account name."
+ (alist-get 'acct
+ (mastodon-return-credential-account)))
+
+(defun mastodon-auth--get-account-id ()
+ "Request user credentials and return an account name."
+ (alist-get 'id
+ (mastodon-return-credential-account)))
+
+(defun mastodon-auth--user-acct ()
+ "Return a mastodon user acct name."
+ (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist))
+ (let ((acct (mastodon-auth--get-account-name)))
+ (push (cons mastodon-instance-url acct) mastodon-auth--acct-alist)
+ acct)))
+
+(provide 'mastodon-auth)
+;;; mastodon-auth.el ends here
--- /dev/null
+;;; mastodon-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from mastodon.el
+
+(autoload 'mastodon-forget-all-logins "mastodon"
+"Delete `mastodon-client--token-file'.
+Also nil `mastodon-auth--token-alist'." t)
+(autoload 'mastodon "mastodon"
+"Connect client to `mastodon-instance-url' instance.
+If there are any open mastodon.el buffers, switch to one instead.
+Prority in switching is given to timeline views." t)
+(autoload 'mastodon-toot "mastodon"
+"Update instance with new toot. Content is captured in a new buffer.
+If USER is non-nil, insert after @ symbol to begin new toot.
+If REPLY-TO-ID is non-nil, attach new toot to a conversation.
+If REPLY-JSON is the json of the toot being replied to.
+QUOTE-ID is the id of a toot being quoted, QUOTE-JSON is its data.
+VISIBILITY is the visibility of the toot.
+
+(fn &optional USER REPLY-TO-ID REPLY-JSON QUOTE-ID QUOTE-JSON VISIBILITY)" t)
+(autoload 'mastodon-notifications-get "mastodon"
+"Display NOTIFICATIONS in buffer.
+Optionally only print notifications of type TYPE, a string.
+BUFFER-NAME is added to \"*mastodon-\" to create the buffer name.
+MAX-ID is a request parameter for pagination.
+
+(fn &optional TYPE BUFFER-NAME MAX-ID)" t)
+(autoload 'mastodon-notifications-check "mastodon"
+"Check for the number of unread notifications." t)
+(autoload 'mastodon-url-lookup "mastodon"
+"If a URL resembles a fediverse link, try to load in `mastodon.el'.
+Does a WebFinger lookup on the server.
+URL can be arg QUERY-URL, or URL at point, or provided by the user.
+If a status or account is found, load it in `mastodon.el', if
+not, just browse the URL in the normal fashion.
+If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'.
+
+(fn &optional QUERY-URL FORCE)" t)
+(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
+(register-definition-prefixes "mastodon" '("mastodon-"))
+
+\f
+;;; Generated autoloads from mastodon-async.el
+
+(autoload 'mastodon-async-mode "mastodon-async"
+"Async Mastodon.
+
+This is a minor mode. If called interactively, toggle the
+`Mastodon-Async mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate the variable `mastodon-async-mode'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(register-definition-prefixes "mastodon-async" '("mastodon-async--"))
+
+\f
+;;; Generated autoloads from mastodon-auth.el
+
+(register-definition-prefixes "mastodon-auth" '("mastodon-auth-"))
+
+\f
+;;; Generated autoloads from mastodon-client.el
+
+(register-definition-prefixes "mastodon-client" '("mastodon-client"))
+
+\f
+;;; Generated autoloads from mastodon-discover.el
+
+(register-definition-prefixes "mastodon-discover" '("mastodon-discover"))
+
+\f
+;;; Generated autoloads from mastodon-http.el
+
+(register-definition-prefixes "mastodon-http" '("mastodon-http--"))
+
+\f
+;;; Generated autoloads from mastodon-inspect.el
+
+(register-definition-prefixes "mastodon-inspect" '("mastodon-inspect--"))
+
+\f
+;;; Generated autoloads from mastodon-iso.el
+
+(register-definition-prefixes "mastodon-iso" '("mastodon-iso-639-"))
+
+\f
+;;; Generated autoloads from mastodon-media.el
+
+(register-definition-prefixes "mastodon-media" '("mastodon-media--"))
+
+\f
+;;; Generated autoloads from mastodon-notifications.el
+
+(register-definition-prefixes "mastodon-notifications" '("mastodon-"))
+
+\f
+;;; Generated autoloads from mastodon-profile.el
+
+(register-definition-prefixes "mastodon-profile" '("mastodon-profile"))
+
+\f
+;;; Generated autoloads from mastodon-search.el
+
+(register-definition-prefixes "mastodon-search" '("mastodon-search-"))
+
+\f
+;;; Generated autoloads from mastodon-tl.el
+
+(register-definition-prefixes "mastodon-tl" '("mastodon-" "with-mastodon-buffer"))
+
+\f
+;;; Generated autoloads from mastodon-toot.el
+
+(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe)
+(register-definition-prefixes "mastodon-toot" '("mastodon-t"))
+
+\f
+;;; Generated autoloads from mastodon-transient.el
+
+(register-definition-prefixes "mastodon-transient" '("mastodon-"))
+
+\f
+;;; Generated autoloads from mastodon-views.el
+
+(autoload 'mastodon-views-view-scheduled-toots "mastodon-views"
+"Show the user's scheduled toots in a new buffer." t)
+(autoload 'mastodon-views-view-filters "mastodon-views"
+"View the user's filters in a new buffer." t)
+(register-definition-prefixes "mastodon-views" '("mastodon-views-"))
+
+\f
+;;; Generated autoloads from mastodon-widget.el
+
+(register-definition-prefixes "mastodon-widget" '("mastodon-widget-"))
+\f
+;;; End of scraped data
+
+(provide 'mastodon-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; mastodon-autoloads.el ends here
--- /dev/null
+;;; mastodon-client.el --- Client functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2021 Abhiseck Paira <abhiseckpairaNOSPAMdisroot.org>
+;; Copyright (C) 2025 Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-client.el supports registering the Emacs client with your Mastodon instance.
+
+;;; Code:
+
+(require 'plstore)
+(require 'json)
+(require 'url)
+
+(defvar mastodon-instance-url)
+(defvar mastodon-active-user)
+(defvar mastodon-auth-use-auth-source)
+
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--post "mastodon-http")
+(autoload 'mastodon-auth-source-token "mastodon-auth")
+
+(defcustom mastodon-client--token-file
+ (concat user-emacs-directory "mastodon.plstore")
+ "File path where Mastodon access tokens are stored."
+ :group 'mastodon
+ :type 'file)
+
+(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" . ,mastodon-client-redirect-uri)
+ ("scopes" . ,mastodon-client-scopes)
+ ("website" . ,mastodon-client-website))
+ nil
+ :unauthenticated))
+
+(defun mastodon-client--fetch ()
+ "Return JSON from `mastodon-client--register' call."
+ (let ((buf (mastodon-client--register)))
+ (if (not buf)
+ (user-error "Client registration failed.\
+ Is `mastodon-instance-url' correct?")
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (re-search-forward "^$" nil 'move)
+ (let* ((json-object-type 'plist)
+ (json-key-type 'keyword)
+ (json-array-type 'vector)
+ (json-string
+ (buffer-substring-no-properties (point) (point-max)))
+ (parsed
+ (json-read-from-string json-string)))
+ (if (eq :error (car parsed))
+ (error "Error: %s" (cadr parsed))
+ parsed))))))
+
+(defun mastodon-client--token-file ()
+ "Return `mastodon-client--token-file'."
+ mastodon-client--token-file)
+
+(defun mastodon-client--store ()
+ "Store client_id and client_secret in `mastodon-client--token-file'.
+Make `mastodon-client--fetch' call to determine client values.
+Return a plist of secret and non-secret key/val pairs."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (client (mastodon-client--fetch))
+ (secrets `( :client_id ,(plist-get client :client_id)
+ :client_secret ,(plist-get client :client_secret)))
+ (sans-secrets
+ (dolist (x '(:client_id :client_secret) client)
+ (cl-remf client x)))
+ ;; alexgriffith reported seeing ellipses in the saved output
+ ;; which indicate some output truncating. Nothing in
+ ;; `plstore-save' seems to ensure this cannot happen so let's do
+ ;; that ourselves:
+ (print-length nil)
+ (print-level nil))
+ (plstore-put plstore
+ (concat "mastodon-" mastodon-instance-url)
+ sans-secrets secrets)
+ ;; FIXME: breaks tests: prompts for gpg passphrase
+ (plstore-save plstore)
+ (plstore-close plstore)
+ (append secrets sans-secrets)))
+
+(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))))
+ (plstore-close plstore)
+ (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)))
+ (plstore-close plstore)
+ (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 encrypted in the plstore.
+Return the plist after the operation.
+If `mastodon-auth-use-auth-source', encrypt it in auth source file."
+ (let* ((user-details (mastodon-client--make-user-details-plist))
+ (plstore (plstore-open (mastodon-client--token-file)))
+ (username (mastodon-client--form-user-from-vars))
+ (key (concat "user-" username))
+ (secrets `( :client_id ,(plist-get user-details :client_id)
+ :client_secret ,(plist-get user-details :client_secret)))
+ (sans-secrets
+ (dolist (x '(:client_id :client_secret) user-details)
+ (cl-remf user-details x)))
+ (print-length nil)
+ (print-level nil))
+ (if mastodon-auth-use-auth-source
+ ;; auth-source:
+ (progn
+ (mastodon-auth-source-token
+ mastodon-instance-url username token :create)
+ (plstore-put plstore key sans-secrets secrets))
+ ;; plstore encrypted:
+ (plstore-put plstore key sans-secrets
+ (append secrets `(:access_token ,token))))
+ (plstore-save plstore)
+ (plstore-close plstore)
+ (cdr (plstore-get plstore key))))
+
+(defun mastodon-client--make-user-active (user-details)
+ "USER-DETAILS is a plist consisting of user details.
+Save it to plstore under key \"active-user\".
+If `mastodon-auth-use-auth-source' is non-nil, fetch the access token
+from the user's auth source file and add it to the active user entry.
+Return a plist of secret and non-secret key/val pairs."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (handle (plist-get user-details :username))
+ (token
+ (if mastodon-auth-use-auth-source
+ (mastodon-auth-source-token mastodon-instance-url handle)
+ (plist-get user-details :access_token)))
+ (secrets `( :access_token ,token
+ :client_id ,(plist-get user-details :client_id)
+ :client_secret ,(plist-get user-details :client_secret)))
+ (deets (copy-sequence user-details))
+ (sans-secrets
+ (dolist (x '(:client_id :client_secret :access_token) deets)
+ (cl-remf deets x)))
+ (print-length nil)
+ (print-level nil))
+ (plstore-put plstore "active-user" sans-secrets secrets)
+ (plstore-save plstore)
+ (plstore-close plstore)
+ (append secrets sans-secrets)))
+
+(defun mastodon-client--form-user-from-vars ()
+ "Create a username from user variable. Return that username.
+Username in the form userNOSPAMinstance.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 (mastodon-client--general-read
+ (concat "user-" username))))
+ (when user-plist
+ (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
+ (string= (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."
+ (or mastodon-client--active-user-details-plist
+ (setq mastodon-client--active-user-details-plist
+ (or (mastodon-client--current-user-active-p)
+ (mastodon-client--make-current-user-active)))))
+
+(defun mastodon-client ()
+ "Return variable client secrets to use for `mastodon-instance-url'.
+If `mastodon-client--client-details-alist' is nil, read plist from
+`mastodon-client--token-file'.
+Fetch and store plist if `mastodon-client--read' returns nil.
+Return a plist."
+ (let ((client-details
+ (cdr (assoc mastodon-instance-url
+ mastodon-client--client-details-alist))))
+ (or client-details
+ (let ((client-details (or (mastodon-client--read)
+ (mastodon-client--store))))
+ (push (cons mastodon-instance-url client-details)
+ mastodon-client--client-details-alist)
+ client-details))))
+
+(provide 'mastodon-client)
+;;; mastodon-client.el ends here
+
--- /dev/null
+;;; mastodon-discover.el --- Use Mastodon.el with discover.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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:
+
+;; This adds optional functionality that can be used if the dicover package
+;; is present.
+;;
+;; See the README file for how to use this.
+
+;;; Code:
+
+(declare-function discover-add-context-menu "discover")
+
+(autoload 'mastodon-kill-window "mastodon")
+
+(defun mastodon-discover ()
+ "Plug Mastodon functionality into `discover'."
+ (interactive)
+ (when (require 'discover nil :noerror)
+ (discover-add-context-menu
+ :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-toggle-bookmark)
+ ("v" "Vote on poll" mastodon-tl-poll-vote)
+ ("n" "Next" mastodon-tl-goto-next-item)
+ ("p" "Prev" mastodon-tl-goto-prev-item)
+ ("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)
+ ("o" "Open toot URL" mastodon-toot-browse-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)
+ ("'" "Followed tags timeline" mastodon-tl-followed-tags-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)
+ ("g/u" "Update timeline" mastodon-tl-update)
+ ("s" "Search" mastodon-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." mastodon--kill-window)
+ ("M-C-q" "Quit mastodon and kill all buffers." mastodon-kill-all-buffers)))))))
+
+(provide 'mastodon-discover)
+;;; mastodon-discover.el ends here
--- /dev/null
+;;; mastodon-http.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-http.el provides HTTP request/response functions.
+
+;;; Code:
+
+(require 'json)
+(require 'url)
+(require 'url-http)
+(require 'shr)
+
+(defvar mastodon-instance-url)
+(defvar mastodon-toot--media-attachment-ids)
+(defvar mastodon-toot--media-attachment-filenames)
+
+(autoload 'mastodon-auth--access-token "mastodon-auth")
+(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
+(autoload 'url-insert "url-handlers")
+
+(defvar mastodon-http--api-version "v1")
+
+(defconst mastodon-http--timeout 15
+ "HTTP request timeout, in seconds. Has no effect on Emacs < 26.1.")
+
+(defun mastodon-http--api (endpoint &optional version)
+ "Return Mastodon API URL for ENDPOINT.
+Optionally specify VERSION in format vX."
+ (concat mastodon-instance-url "/api/"
+ (or version mastodon-http--api-version) "/" endpoint))
+
+(defun mastodon-http--api-v2 (endpoint)
+ "Return Mastodon API v2 URL for ENDPOINT."
+ (mastodon-http--api endpoint "v2"))
+
+(defun mastodon-http--url-retrieve-synchronously (url &optional silent)
+ "Retrieve URL asynchronously.
+This is a thin abstraction over the system
+`url-retrieve-synchronously'. Depending on which version of this
+is available we will call it with or without a timeout.
+SILENT means don't message."
+ (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
+ (url-retrieve-synchronously url)
+ (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout)))
+
+(defun mastodon-http--response-status (resp)
+ "Return the status code from RESP, a response buffer."
+ ;; `url-http-parse-response' breaks tests, as
+ ;; `url-http-end-of-headers' not set, so we roll our own:
+ (with-current-buffer resp
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n") ; Skip any blank crap
+ (skip-chars-forward "/HPT0-9.") ; Skip HTTP Version "HTTP/X.Y"
+ (read (current-buffer))))
+
+(defun mastodon-http--triage (response success)
+ "Determine if RESPONSE was successful.
+Call SUCCESS on RESPONSE if successful. Message status and JSON error
+from RESPONSE if unsuccessful."
+ (let ((status (mastodon-http--response-status response)))
+ (if (and (>= 200 status)
+ (<= status 299))
+ ;; (string-prefix-p "2" (number-to-string status))
+ (funcall success response)
+ (if (= 404 status)
+ (message "Error %s: page not found" status)
+ (let ((json-response (with-current-buffer response
+ (mastodon-http--process-json))))
+ (message "Error %s: %s" status (alist-get 'error json-response)))))))
+
+(defun mastodon-http--read-file-as-string (filename &optional url)
+ "Read a file FILENAME as a string.
+Used to generate image preview.
+URL means FILENAME is a URL."
+ (with-temp-buffer
+ (if url
+ (url-insert-file-contents filename)
+ (insert-file-contents filename))
+ (string-to-unibyte (buffer-string))))
+
+(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p)
+ "Make a METHOD type request using BODY, with Mastodon authorization.
+Unless UNAUTHENTICATED-P is non-nil."
+ (declare (debug 'body)
+ (indent 1))
+ `(let ((url-request-method ,method)
+ (url-request-extra-headers
+ (unless ,unauthenticated-p
+ (list (cons "Authorization"
+ (concat "Bearer " (mastodon-auth--access-token)))))))
+ ,body))
+
+(defun mastodon-http--build-params-string (params)
+ "Build a request parameters string from parameters alist PARAMS."
+ ;; (url-build-query-string args nil))
+ ;; url-build-query-string adds 'nil' for empty params so lets stick with our
+ ;; own:
+ (mapconcat (lambda (p)
+ (when (cdr p) ; only when value
+ (concat (url-hexify-string (car p))
+ "=" (url-hexify-string (cdr p)))))
+ params "&"))
+
+(defun mastodon-http--build-array-params-alist (param-str array)
+ "Return parameters alist using PARAM-STR and ARRAY param values.
+Used for API form data parameters that take an array."
+ (cl-loop for x in array
+ collect (cons param-str x)))
+
+(defun mastodon-http--concat-params-to-url (url params)
+ "Build a query string with PARAMS and concat to URL."
+ (if params
+ (concat url "?"
+ (mastodon-http--build-params-string params))
+ url))
+
+(defun mastodon-http--post (url
+ &optional params headers unauthenticated-p json)
+ "POST synchronously to URL, optionally with PARAMS and HEADERS.
+Authorization header is included by default unless
+UNAUTHENTICATED-P is non-nil.
+If JSON is :json, encode PARAMS as JSON for
+the request data. If it is :raw, just use the plain params."
+ ;; NB: raw is used by `mastodon-tl-unfilter-user-languages'; not sure if
+ ;; there's a way around it?
+ (mastodon-http--authorized-request "POST"
+ (let* ((url-request-data
+ (when params
+ (cond ((eq json :json)
+ (json-encode params))
+ ((eq json :raw)
+ params)
+ (t
+ (mastodon-http--build-params-string params)))))
+ (url-request-extra-headers
+ (append url-request-extra-headers ; auth set in macro
+ (if json
+ '(("Content-Type" . "application/json")
+ ("Accept" . "application/json"))
+ (unless (assoc "Content-Type" headers) ; pleroma compat:
+ '(("Content-Type" . "application/x-www-form-urlencoded"))))
+ headers)))
+ (with-temp-buffer
+ (mastodon-http--url-retrieve-synchronously url)))
+ unauthenticated-p))
+
+(defun mastodon-http--get (url &optional params silent)
+ "Make synchronous GET request to URL.
+PARAMS is an alist of any extra parameters to send with the request.
+SILENT means don't message."
+ (mastodon-http--authorized-request "GET"
+ ;; url-request-data doesn't seem to work with GET requests?:
+ (let ((url (mastodon-http--concat-params-to-url url params)))
+ (mastodon-http--url-retrieve-synchronously url silent))))
+
+(defun mastodon-http--get-response (url &optional params no-headers silent vector)
+ "Make synchronous GET request to URL. Return JSON and response headers.
+PARAMS is an alist of any extra parameters to send with the request.
+SILENT means don't message.
+NO-HEADERS means don't collect http response headers.
+VECTOR means return json arrays as vectors."
+ (let ((buf (mastodon-http--get url params silent)))
+ ;; --get can return nil if instance unresponsive:
+ (if (not buf)
+ (user-error "Looks like the server response borked. \
+Is your instance up?")
+ (with-current-buffer buf
+ (mastodon-http--process-response no-headers vector)))))
+
+(defun mastodon-http--get-json (url &optional params silent vector)
+ "Return only JSON data from URL request.
+PARAMS is an alist of any extra parameters to send with the request.
+SILENT means don't message.
+VECTOR means return json arrays as vectors."
+ (car (mastodon-http--get-response url params :no-headers silent vector)))
+
+(defun mastodon-http--process-json ()
+ "Return only JSON data from async URL request.
+Callback to `mastodon-http--get-json-async', usually
+`mastodon-tl--init*', is run on the result."
+ (car (mastodon-http--process-response :no-headers)))
+
+(defun mastodon-http--render-html-err (string)
+ "Render STRING as HTML in a temp buffer.
+STRING should be a HTML for a 404 errror."
+ (with-temp-buffer
+ (insert string)
+ (shr-render-buffer (current-buffer))
+ (view-mode))) ; for 'q' to kill buffer and window
+ ;; (error ""))) ; stop subsequent processing
+
+(defun mastodon-http--process-response (&optional no-headers vector)
+ "Process http response.
+Return a cons of JSON list and http response headers.
+If NO-HEADERS is non-nil, just return the JSON.
+VECTOR means return json arrays as vectors.
+Callback to `mastodon-http--get-response-async', usually
+`mastodon-tl--init*', is run on the result."
+ ;; view raw response:
+ ;; (switch-to-buffer (current-buffer))
+ (let ((headers (unless no-headers
+ (mastodon-http--process-headers))))
+ (goto-char (point-min))
+ (re-search-forward "^$" nil 'move)
+ (let ((json-array-type (if vector 'vector 'list))
+ (json-string (string-trim-right
+ (decode-coding-string
+ (buffer-substring-no-properties (point) (point-max))
+ 'utf-8))))
+ (kill-buffer)
+ (cond ((or (string-empty-p json-string) (null json-string))
+ nil)
+ ;; if we get html, just render it and error:
+ ;; ideally we should handle the status code in here rather than
+ ;; this crappy hack?
+ ((string-prefix-p "\n<" json-string) ; html hack
+ ;; NB: in this case, process-response returns t!:
+ (mastodon-http--render-html-err json-string)
+ nil) ;; return nil instead of t
+ ;; if no json or html, maybe we have a plain string error message
+ ;; (misskey does this, but there are probably better ways to do
+ ;; this):
+ ((not (or (string-prefix-p "\n{" json-string)
+ (string-prefix-p "\n[" json-string)))
+ (error "%s" json-string))
+ (t
+ ;; instance may return error in JSON e.g. ((error . "Record not
+ ;; found")) for a null endpoint. but we don't error here because
+ ;; sometimes we just want to check for such an error in an
+ ;; if/cond.
+ `(,(json-read-from-string json-string) . ,headers))))))
+
+(defun mastodon-http--process-headers ()
+ "Return an alist of http response headers."
+ (goto-char (point-min))
+ (let* ((head-str (buffer-substring-no-properties
+ (point-min)
+ (re-search-forward "^$" nil 'move)))
+ (head-list (split-string head-str "\n")))
+ (mapcar (lambda (x)
+ (let ((list (split-string x ": ")))
+ (cons (car list) (cadr list))))
+ head-list)))
+
+(defun mastodon-http--delete (url &optional params)
+ "Make DELETE request to URL.
+PARAMS is an alist of any extra parameters to send with the request."
+ ;; url-request-data only works with POST requests?
+ (let ((url (mastodon-http--concat-params-to-url url params)))
+ (mastodon-http--authorized-request "DELETE"
+ (with-temp-buffer
+ (mastodon-http--url-retrieve-synchronously url)))))
+
+(defun mastodon-http--put (url &optional params headers)
+ "Make PUT request to URL.
+PARAMS is an alist of any extra parameters to send with the request.
+HEADERS is an alist of any extra headers to send with the request."
+ (mastodon-http--authorized-request "PUT"
+ (let ((url-request-data
+ (when params (mastodon-http--build-params-string params)))
+ (url-request-extra-headers
+ (append url-request-extra-headers ; auth set in macro
+ (unless (assoc "Content-Type" headers) ; pleroma compat:
+ '(("Content-Type" . "application/x-www-form-urlencoded")))
+ headers)))
+ (with-temp-buffer (mastodon-http--url-retrieve-synchronously url)))))
+
+;; profile update functions
+
+(defun mastodon-http--patch-json (url &optional params)
+ "Make synchronous PATCH request to URL. Return JSON response.
+Optionally specify the PARAMS to send."
+ (with-current-buffer (mastodon-http--patch url params)
+ (mastodon-http--process-json)))
+
+(defun mastodon-http--patch (url &optional params json)
+ "Make synchronous PATCH request to URL.
+Optionally specify the PARAMS to send.
+JSON means send params as JSON data."
+ (mastodon-http--authorized-request "PATCH"
+ ;; NB: unlike POST, PATCHing only works if we use query params!
+ ;; so here, unless JSON arg, we use query params and do not set
+ ;; `url-request-data'. this is probably an error, i don't understand it.
+ (let* ((url-request-data
+ (when (and params json)
+ (encode-coding-string
+ (json-encode params) 'utf-8)))
+ ;; (mastodon-http--build-params-string params))))
+ (url (if (not json)
+ (mastodon-http--concat-params-to-url url params)
+ url))
+ (headers (when json
+ '(("Content-Type" . "application/json")
+ ("Accept" . "application/json"))))
+ (url-request-extra-headers
+ (append url-request-extra-headers headers)))
+ (mastodon-http--url-retrieve-synchronously url))))
+
+\f ;; Asynchronous functions
+
+(defun mastodon-http--get-async (url &optional params silent
+ callback &rest cbargs)
+ "Make GET request to URL.
+Pass response buffer to CALLBACK function with args CBARGS.
+PARAMS is an alist of any extra parameters to send with the request.
+Optionally make the request SILENT."
+ (let ((url (mastodon-http--concat-params-to-url url params)))
+ (mastodon-http--authorized-request "GET"
+ (url-retrieve url callback cbargs silent))))
+
+(defun mastodon-http--get-response-async (url &optional params silent
+ callback &rest cbargs)
+ "Make GET request to URL. Call CALLBACK with http response and CBARGS.
+PARAMS is an alist of any extra parameters to send with the request.
+Optionally make the request SILENT."
+ (mastodon-http--get-async
+ url
+ params silent
+ (lambda (status)
+ (when status ; for flakey servers
+ (apply callback (mastodon-http--process-response) cbargs)))))
+
+(defun mastodon-http--get-json-async (url &optional params silent
+ callback &rest cbargs)
+ "Make GET request to URL. Call CALLBACK with json-list and CBARGS.
+PARAMS is an alist of any extra parameters to send with the request.
+Optionally make the request SILENT."
+ (mastodon-http--get-async
+ url
+ params silent
+ (lambda (status)
+ (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)
+ "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."
+ (mastodon-http--authorized-request "POST"
+ (let ((url-request-data (when params
+ (mastodon-http--build-params-string params))))
+ (with-temp-buffer
+ (url-retrieve url callback cbargs)))))
+
+(defun mastodon-http--get-cb-data (status)
+ "Return data using `json-read' after a successful async request.
+If STATUS includes an error, emit a message describing it and return nil."
+ (let* ((buf (current-buffer))
+ (data (with-temp-buffer
+ (url-insert buf)
+ (goto-char (point-min))
+ (json-read))))
+ (if-let* ((error-thrown (plist-get status :error)))
+ ;; not necessarily a user error, but we want its functionality:
+ (user-error "%S %s" error-thrown (alist-get 'error data))
+ data)))
+
+(defun mastodon-http--post-media-callback (status file caption buffer)
+ "Callback function called after posting FILE as an attachment with CAPTION.
+The toot is being composed in BUFFER. See `url-retrieve' for STATUS."
+ (unwind-protect
+ (when-let* ((data (mastodon-http--get-cb-data status)))
+ (with-current-buffer buffer
+ (let ((id (alist-get 'id data)))
+ ;; update ids:
+ (if (not mastodon-toot--media-attachment-ids)
+ ;; add first id:
+ (push id mastodon-toot--media-attachment-ids)
+ ;; add new id to end of list to preserve order:
+ (push id (cdr
+ (last mastodon-toot--media-attachment-ids))))
+ ;; pleroma, PUT the description:
+ ;; this is how the mangane akkoma web client does it
+ ;; and it seems easier than the other options!
+ (when (and caption
+ (not (string= caption (alist-get 'description data))))
+ (let ((url (mastodon-http--api (format "media/%s" id))))
+ ;; (message "PUTting image description")
+ (mastodon-http--put url `(("description" . ,caption)))))
+ (message "Uploading %s... (done)" file)
+ (mastodon-toot--update-status-fields))))
+ (kill-buffer (current-buffer))))
+
+(defun mastodon-http--post-media-prep-file (filename)
+ "Return the request data to upload FILENAME."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename)
+ (let ((boundary (buffer-hash)))
+ (goto-char (point-min))
+ (insert "--" boundary "\r\n"
+ (format "Content-Disposition: form-data; name=\"file\"; filename=\"%s\"\r\n\r\n"
+ (file-name-nondirectory filename)))
+ (goto-char (point-max))
+ (insert "\r\n" "--" boundary "--" "\r\n")
+ `(,boundary . ,(buffer-substring-no-properties (point-min) (point-max))))))
+
+(defun mastodon-http--post-media-attachment (url filename caption)
+ "Make POST request to upload FILENAME with CAPTION to the server's media URL.
+The upload is asynchronous. On succeeding,
+`mastodon-toot--media-attachment-ids' is set to the id(s) of the
+item uploaded, and `mastodon-toot--update-status-fields' is run."
+ (mastodon-http--authorized-request "POST"
+ (let* ((data (mastodon-http--post-media-prep-file filename))
+ (url-request-extra-headers
+ (append url-request-extra-headers ; auth set in macro
+ `(("Content-Type" . ,(format "multipart/form-data; boundary=%s"
+ (car data))))))
+ (url-request-data (cdr data))
+ (params `(("description" . ,caption)))
+ (url (mastodon-http--concat-params-to-url url params)))
+ (url-retrieve url #'mastodon-http--post-media-callback
+ `(,filename ,caption ,(current-buffer))))))
+
+(provide 'mastodon-http)
+;;; mastodon-http.el ends here
--- /dev/null
+;;; mastodon-inspect.el --- Client for Mastodon -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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:
+
+;; Some tools to help inspect / debug mastodon.el
+
+;;; Code:
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-http--get-search-json "mastodon-http")
+(autoload 'mastodon-media--inline-images "mastodon-media")
+(autoload 'mastodon-mode "mastodon")
+(autoload 'mastodon-tl--as-string "mastodon-tl")
+(autoload 'mastodon-tl--property "mastodon-tl")
+(autoload 'mastodon-tl--toot "mastodon-tl")
+
+(defvar mastodon-instance-url)
+
+(defgroup mastodon-inspect nil
+ "Tools to help inspect toots."
+ :prefix "mastodon-inspect-"
+ :group 'external)
+
+(defun mastodon-inspect--dump-json-in-buffer (name json)
+ "Buffer NAME is opened and JSON in printed into it."
+ (switch-to-buffer-other-window name)
+ (erase-buffer)
+ (let ((print-level nil)
+ (print-length nil))
+ (pp json (current-buffer))
+ (goto-char (point-min))
+ (emacs-lisp-mode)
+ (message "success")))
+
+(defun mastodon-inspect--toot ()
+ "Find next toot and dump its meta data into new buffer."
+ (interactive)
+ (mastodon-inspect--dump-json-in-buffer
+ (concat "*mastodon-inspect-toot-"
+ (mastodon-tl--as-string (mastodon-tl--property 'item-id))
+ "*")
+ (mastodon-tl--property 'item-json)))
+
+(defun mastodon-inspect--download-single-toot (item-id)
+ "Download the toot/status represented by ITEM-ID."
+ (mastodon-http--get-json
+ (mastodon-http--api (concat "statuses/" item-id))))
+
+(defun mastodon-inspect--view-single-toot (item-id)
+ "View the toot/status represented by ITEM-ID."
+ (interactive "s Toot ID: ")
+ (let ((buffer (get-buffer-create (concat "*mastodon-status-" item-id "*"))))
+ (with-current-buffer buffer
+ (let ((toot (mastodon-inspect--download-single-toot item-id )))
+ (mastodon-tl--toot toot)
+ (goto-char (point-min))
+ (while (search-forward "\n\n\n | " nil t)
+ (replace-match "\n | "))
+ (mastodon-media--inline-images (point-min) (point-max))))
+ (switch-to-buffer-other-window buffer)
+ (mastodon-mode)))
+
+(defun mastodon-inspect--view-single-toot-source (item-id)
+ "View the ess source of a toot/status represented by ITEM-ID."
+ (interactive "s Toot ID: ")
+ (mastodon-inspect--dump-json-in-buffer
+ (concat "*mastodon-status-raw-" item-id "*")
+ (mastodon-inspect--download-single-toot item-id)))
+
+
+(defvar mastodon-inspect--search-query-accounts-result)
+(defvar mastodon-inspect--single-account-json)
+
+(defvar mastodon-inspect--search-query-full-result)
+(defvar mastodon-inspect--search-result-tags)
+
+(defun mastodon-inspect--get-search-result (query)
+ "Inspect function for a search result for QUERY."
+ (interactive)
+ (setq mastodon-inspect--search-query-full-result
+ (append ; convert vector to list
+ (mastodon-http--get-search-json
+ (format "%s/api/v2/search" mastodon-instance-url)
+ query)
+ nil))
+ (setq mastodon-inspect--search-result-tags
+ (append (cdr
+ (caddr mastodon-inspect--search-query-full-result))
+ nil)))
+
+(defun mastodon-inspect--get-search-account (query)
+ "Return JSON for a single account after search QUERY."
+ (interactive)
+ (setq mastodon-inspect--search-query-accounts-result
+ (append ; convert vector to list
+ (mastodon-http--get-search-json
+ (format "%s/api/v1/accounts/search" mastodon-instance-url)
+ query)
+ nil))
+ (setq mastodon-inspect--single-account-json
+ (car mastodon-inspect--search-query-accounts-result)))
+
+
+(provide 'mastodon-inspect)
+;;; mastodon-inspect.el ends here
--- /dev/null
+;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Marty Hiatt
+;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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:
+
+;;; Code:
+
+;; via
+;; https://github.com/VyrCossont/mastodon/blob/0836f4a656d5486784cadfd7d0cd717bb67ede4c/app/helpers/languages_helper.rb
+;; and
+;; https://github.com/Shinmera/language-codes/blob/master/data/iso-639-3.lisp
+
+(defvar mastodon-iso-639-1
+ '(("Abkhazian" . "ab")
+ ("Afar" . "aa")
+ ("Afrikaans" . "af")
+ ("Akan" . "ak")
+ ("Albanian" . "sq")
+ ("Amharic" . "am")
+ ("Arabic" . "ar")
+ ("Aragonese" . "an")
+ ("Armenian" . "hy")
+ ("Assamese" . "as")
+ ("Avaric" . "av")
+ ("Avestan" . "ae")
+ ("Aymara" . "ay")
+ ("Azerbaijani" . "az")
+ ("Bambara" . "bm")
+ ("Bashkir" . "ba")
+ ("Basque" . "eu")
+ ("Belarusian" . "be")
+ ("Bengali" . "bn")
+ ("Bihari languages" . "bh")
+ ("Bislama" . "bi")
+ ("Bosnian" . "bs")
+ ("Breton" . "br")
+ ("Bulgarian" . "bg")
+ ("Burmese" . "my")
+ ("Central Khmer" . "km")
+ ("Chamorro" . "ch")
+ ("Chechen" . "ce")
+ ("Chinese" . "zh")
+ ("Chuvash" . "cv")
+ ("Cornish" . "kw")
+ ("Corsican" . "co")
+ ("Cree" . "cr")
+ ("Croatian" . "hr")
+ ("Czech" . "cs")
+ ("Danish" . "da")
+ ("Dzongkha" . "dz")
+ ("English" . "en")
+ ("Esperanto" . "eo")
+ ("Estonian" . "et")
+ ("Ewe" . "ee")
+ ("Faroese" . "fo")
+ ("Fijian" . "fj")
+ ("Finnish" . "fi")
+ ("Dutch" . "nl")
+ ("French" . "fr")
+ ("Fulah" . "ff")
+ ("Galician" . "gl")
+ ("Ganda" . "lg")
+ ("Georgian" . "ka")
+ ("German" . "de")
+ ("Greek" . "el")
+ ("Guarani" . "gn")
+ ("Gujarati" . "gu")
+ ("Haitian" . "ht")
+ ("Hausa" . "ha")
+ ("Hebrew" . "he")
+ ("Herero" . "hz")
+ ("Hindi" . "hi")
+ ("Hiri Motu" . "ho")
+ ("Hungarian" . "hu")
+ ("Icelandic" . "is")
+ ("Ido" . "io")
+ ("Igbo" . "ig")
+ ("Indonesian" . "id")
+ ("Interlingua" . "ia")
+ ("Inuktitut" . "iu")
+ ("Inupiaq" . "ik")
+ ("Irish" . "ga")
+ ("Italian" . "it")
+ ("Japanese" . "ja")
+ ("Japanese" . "jp")
+ ("Javanese" . "jv")
+ ("Kalaallisut" . "kl")
+ ("Kannada" . "kn")
+ ("Kanuri" . "kr")
+ ("Kashmiri" . "ks")
+ ("Kazakh" . "kk")
+ ("Kikuyu" . "ki")
+ ("Kinyarwanda" . "rw")
+ ("Komi" . "kv")
+ ("Kongo" . "kg")
+ ("Korean" . "ko")
+ ("Kurdish" . "ku")
+ ("Kuanyama" . "kj")
+ ("Kirghiz" . "ky")
+ ("Lao" . "lo")
+ ("Latin" . "la")
+ ("Latvian" . "lv")
+ ("Limburgan" . "li")
+ ("Lingala" . "ln")
+ ("Lithuanian" . "lt")
+ ("Luba-Katanga" . "lu")
+ ("Luxembourgish" . "lb")
+ ("Macedonian" . "mk")
+ ("Malagasy" . "mg")
+ ("Malay" . "ms")
+ ("Malayalam" . "ml")
+ ("Divehi" . "dv")
+ ("Maltese" . "mt")
+ ("Manx" . "gv")
+ ("Maori" . "mi")
+ ("Marathi" . "mr")
+ ("Marshallese" . "mh")
+ ("Mongolian" . "mn")
+ ("Nauru" . "na")
+ ("Navajo" . "nv")
+ ("Ndonga" . "ng")
+ ("Nepali" . "ne")
+ ("Ndebele, North" . "nd")
+ ("Northern Sami" . "se")
+ ("Norwegian" . "no")
+ ("Bokmål, Norwegian" . "nb")
+ ("Chichewa" . "ny")
+ ("Norwegian Nynorsk" . "nn")
+ ("Interlingue" . "ie")
+ ("Occitan" . "oc")
+ ("Ojibwa" . "oj")
+ ("Church Slavic" . "cu")
+ ("Oriya" . "or")
+ ("Oromo" . "om")
+ ("Ossetian" . "os")
+ ("Pali" . "pi")
+ ("Persian" . "fa")
+ ("Polish" . "pl")
+ ("Portuguese" . "pt")
+ ("Panjabi" . "pa")
+ ("Pushto" . "ps")
+ ("Quechua" . "qu")
+ ("Romanian" . "ro")
+ ("Romansh" . "rm")
+ ("Rundi" . "rn")
+ ("Russian" . "ru")
+ ("Samoan" . "sm")
+ ("Sango" . "sg")
+ ("Sanskrit" . "sa")
+ ("Sardinian" . "sc")
+ ("Gaelic" . "gd")
+ ("Serbian" . "sr")
+ ("Shona" . "sn")
+ ("Sichuan Yi" . "ii")
+ ("Sindhi" . "sd")
+ ("Sinhala" . "si")
+ ("Slovak" . "sk")
+ ("Slovenian" . "sl")
+ ("Somali" . "so")
+ ("Sotho, Southern" . "st")
+ ("Ndebele, South" . "nr")
+ ("Spanish" . "es")
+ ("Sundanese" . "su")
+ ("Swahili" . "sw")
+ ("Swati" . "ss")
+ ("Swedish" . "sv")
+ ("Tagalog" . "tl")
+ ("Tahitian" . "ty")
+ ("Tajik" . "tg")
+ ("Tamil" . "ta")
+ ("Tatar" . "tt")
+ ("Telugu" . "te")
+ ("Thai" . "th")
+ ("Tibetan" . "bo")
+ ("Tigrinya" . "ti")
+ ("Tonga (Tonga Islands)" . "to")
+ ("Tsonga" . "ts")
+ ("Tswana" . "tn")
+ ("Turkish" . "tr")
+ ("Turkmen" . "tk")
+ ("Twi" . "tw")
+ ("Ukrainian" . "uk")
+ ("Urdu" . "ur")
+ ("Uighur" . "ug")
+ ("Uzbek" . "uz")
+ ("Catalan" . "ca")
+ ("Venda" . "ve")
+ ("Vietnamese" . "vi")
+ ("Volapük" . "vo")
+ ("Walloon" . "wa")
+ ("Welsh" . "cy")
+ ("Western Frisian" . "fy")
+ ("Wolof" . "wo")
+ ("Xhosa" . "xh")
+ ("Yiddish" . "yi")
+ ("Yoruba" . "yo")
+ ("Zhuang" . "za")
+ ("Zulu" . "zu")))
+
+;; web UI doesn't respect these for now
+(defvar mastodon-iso-639-regional
+ '(("es-AR" "Español (Argentina)")
+ ("es-MX" "Español (México)")
+ ("pt-BR" "Português (Brasil)")
+ ("pt-PT" "Português (Portugal)")
+ ("sr-Latn" "Srpski (latinica)")
+ ("zh-CN" "简体中文")
+ ("zh-HK" "繁體中文（香港）")
+ ("zh-TW" "繁體中文（臺灣）")))
+
+(defvar mastodon-iso-639-3
+ '(("ast" "Asturian" "Asturianu")
+ ("ckb" "Sorani (Kurdish)" "سۆرانی")
+ ("jbo" "Lojban" "la .lojban.")
+ ("kab" "Kabyle" "Taqbaylit")
+ ("kmr" "Kurmanji (Kurdish)" "Kurmancî")
+ ("ldn" "Láadan" "Láadan")
+ ("lfn" "Lingua Franca Nova" "lingua franca nova")
+ ("tok" "Toki Pona" "toki pona")
+ ("zba" "Balaibalan" "باليبلن")
+ ("zgh" "Standard Moroccan Tamazight" "ⵜⴰⵎⴰⵣⵉⵖⵜ")))
+
+(provide 'mastodon-iso)
+;;; mastodon-iso.el ends here
--- /dev/null
+;;; mastodon-media.el --- Functions for inlining Mastodon media -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-media.el provides functions for inlining media.
+
+;; Known bug gnutls -12 when trying to access images on some systems.
+;; It looks like their may be a version mismatch between the encryption
+;; required by the server and client.
+
+;;; Code:
+(require 'url-cache)
+(require 'mm-decode)
+(require 'image-mode)
+
+(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl")
+(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
+(autoload 'mastodon-image-mode "mastodon-tl")
+
+(defvar url-show-status)
+
+(defvar mastodon-tl--shr-image-map-replacement)
+
+(defgroup mastodon-media nil
+ "Inline Mastadon media."
+ :prefix "mastodon-media-"
+ :group 'mastodon)
+
+(defcustom mastodon-media--avatar-height 20
+ "Height of the user avatar images (if shown)."
+ :type 'integer)
+
+(defcustom mastodon-media--preview-max-height 250
+ "Max height of any media attachment preview to be shown in timelines."
+ :type 'integer)
+
+(defcustom mastodon-media--enable-image-caching nil
+ "Whether images should be cached."
+ :type 'boolean)
+
+(defcustom mastodon-media--hide-sensitive-media t
+ "Whether media marked as sensitive should be hidden."
+ :type 'boolean)
+
+(defvar mastodon-media--generic-avatar-data
+ (base64-decode-string
+ "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
+B3RJTUUH4QUIFCg2lVD1hwAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAcGSURB
+VHja7dzdT1J/HAfwcw7EQzMKW0pGRMK4qdRZbdrs6aIRbt506V1b/AV1U2td9l9UXnmhW6vgwuko
+SbcOD/a0RB4CCRCRg0AIR4Hz8LvgN2cKCMI5wOH7uXBuugO+eH8+fM/3HIFpmoZAVVYIIABYAAtg
+ASyABbAAAcACWAALYAEsgAUIABbAAlgAC2ABLEAAsAAWwAJYAAtgAQKAxUjxm+R50DRN0zRFUf+8
+kggCwzAMwwDrfyOSJGmattlsdrvd5XLlcrndnyoUir6+vpGRkZMnT/J4vIarwY26MaTAZLVap6en
+fT7f9vY2QRA7Ozv/vJJ8vkgk4vP5XV1dWq1Wq9VKpdIGkjUGi6IoFEWnp6ddLlcymSRJsvzv83g8
+kUikUCi0Wq1Opzt16lS7YBEE8ebNG6PRiGHYoUwHyW7cuPHo0SOlUsl9LIIgXrx4Ybfb//79e7Qj
+CIXC3t7ex48fX7lyhctYBSkURTOZTC3H4fF4SqXy6dOnLHuxh0VR1PPnz2uX2uv17Nmzy5cvc21R
+StP0q1ev7HZ7XaQgCCJJ0u/3T0xMBINBrmGhKGo0Go88p0p5Wa1Wg8GQSqW4g0XT9NTUFIZhdT9y
+Npudn59nLVwIO7FyuVxVrRIqr1AoZDab2QkXG1hTU1PJZJKhg5MkOT8/HwqFuIBF07TP52MoVrvh
+YqLHG4BlsVi2t7cZfQiSJB0OBwudyDiWzWYjCILpR1lZWeECltPp3LeXwEQFg8FoNNryWPl8noVp
+ws6jgG1lgAWwuI914cIFPp/xnX6ZTCYSiVoeq7+/n4U/Q61Wy+Xylse6desWC8kaGBiQSCQtjyWR
+SGQyGY/HY+4hpFJpV1cXRwa8TqdjtBOHh4fVajVHsLRarVKpZChcUqn07t27LPQgS1gSiUSn04nF
+4rofGYbh4eHhgYEBTq2ztFrtyMhI3ZtRo9GMjY2xEyv2sCQSiV6vV6lUdWzGzs7O8fHxwcFBDq7g
+5XL5kydPent76+LV2dmp1+vv37/P5gqe7SvSDofj5cuXteydwjAslUr1ev2DBw9YPt1pwL0ODodj
+YmLCYrEcYZ8LhmGNRjM+Ps5yphqGBUFQKBQyGo0mk2l1dTWfz5MkSVFUPp8/+GSEQiEMw8eOHYNh
+uLu7e2hoaGxsjM05tbfYvpkNx/FQKBSJRCAI6unpwTBsbW0tmUwWbtc6mCMEQSAIOn78+Llz586f
+P9/T05PL5QKBgEKh4GyyCkZfvnwJhULhcHhzczOTyRRuYMtms/l8PpPJZDKZnZ2dvc9HIBCIxeIT
+J04Uvil87ejoOH36tEwm02g0V69evXjxIkewCkZer/fr16+/f/+OxWKlrvQQBEEQxL7dYQRBhEJh
+0fNwBEHEYrFMJlOpVP39/RqNhgU1prAKTDMzMy6XKxqNJhIJptY+CHLmzBmZTHbp0qXbt2+rVKpW
+wtplWl5eDofDTF803Bs0tVrNKFmdsXAcn52dnZ2dDQaD7DAVJRsdHb1z507dT93rhoXj+MrKytzc
+3NLSEnNNVyHZ2bNnr127NjQ0NDg4WEey+mDhOP7u3bu5ubkyI5z9iMnl8nv37o2OjgoEgmbBisVi
+r1+/ttlsjQ1UmYg9fPiwo6OjwVg4jn///v3Dhw/Ly8vNEKiiXhKJpK+vT6fT1d6S/FqkUBSdnJz0
++/1QsxZFUclkEkXReDxOkuT169dr8TpisnAcN5lMb9++ZfP+11pKIBAUdgpv3rx55BGGtIMUBEG5
+XM7tdhsMhoWFhb3/S8UsVitK1curaqzV1dX379+3nNQ+r42NjSPsPlaH5fP5mnyiV+Ll9XonJyfD
+4XC1XkhVDTgzM/Pz50+oxSubzX779u3z58/VLneQyqUMBsOnT5+acz1V7XoiHo9//PjRZDKl0+n6
+Y3k8HrPZ3Gxr9Fq81tfXl5aWAoFA5cO+IqxIJFLYSIA4VARBuN3uxcXFyoc9v5IGNJvNVquVAw14
+sBktFkt3d7dUKq3k5BGpJFYLCwucacCizZhIJCoJF3JorBYXF//8+QNxtAiCKFwiqKRvkEPnOoqi
+HGvAfeFKJBIVTnqkfKx+/PjBsbleKlwej6cmLI/H43A4OByr3XClUimn03louMphra2teb1eqA0q
+m836fL6tra0jYkUiEb/fz8k3waLhikQiXq+3/NtiSayNjY1fv35BbVP5fN7pdG5tbR0Fy+12c360
+Hxzz5a8KI6V6EMMwzo/2fZ2YTqej0WgqlSoVLqRUDwYCAajNiqKoYDBYphOLY8ViscItVG1VJEmu
+r6+XeU8sjhWPxzc3N9sNiyAIDMOqS1YbDqwKx1YRrFQqxc7HJDRnpdPpUuEqgoVhWL0+i6hFz6tL
+ja3iM4u1zw1qwhlfJihI0bfCNhxYe4NSqg3/A862hQAbrdtHAAAAAElFTkSuQmCC")
+ "The PNG data for a generic 100x100 avatar.")
+
+(defvar mastodon-media--generic-broken-image-data
+ (base64-decode-string
+ "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA
+B3RJTUUH4QUIFQUVFt+0LQAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAdoSURB
+VHja7d1NSFRrAIfx//iB6ZDSMJYVkWEk0ceYFUkkhhQlEUhEg0FlC1eBoRTUwlbRok0TgRQURZAE
+FgpjJmFajpK4kggxpXHRQEGWUJZizpy7uPfC5eKiV+dD5zw/mN05jrxnnjnfcxyWZVkCMKc0SXI4
+HIwEMIcUhgAgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCAAgQAEAhAIQCAAgQA2kBaNP8Jt7ViM
+onErOWsQgEAAAgEIBCAQgEAAAgEIBCAQgEAAEAhAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAA
+AgEIBCAQgEAAAgEIBACBAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgECAxSyNIYitz58/
+a3BwUIODgxoZGVEoFFIoFNK3b980NTWlX79+SZIyMzOVlZWlVatWae3atSooKJDH49HOnTvl8XiU
+ksJ3WSI4LMuyHA7Hgv6IZVmM5D8mJyf1/PlzdXZ2qrOzU8FgcMF/0+126+DBg6qqqlJFRYXS0vhe
++6MP9wI/1wQSJeFwWH6/X01NTWpra9PU1FTM3isvL0/nz5/XuXPntHz5ciqIcSCy/v50L+hlV+Pj
+49a1a9esdevWLXgMTV8ul8u6c+eOFYlELMwtKmNNIOa+fv1qXbp0yXI6nXEP4/+v0tJS6+PHj9RA
+IIk3PT1tXb161crOzk54GP995ebmWt3d3RRBIInj9/utgoKCRRXGf18ZGRmW3++niigHwk56PHf4
+Yiw9PV0dHR0qLy9nD52jWAQylxUrVmhgYEAbN24kkCgsM84+JZmJiQmdPn1akUiEweBE4eL/NsrN
+zVVZWZlKSkpUWFioTZs2yeVyKTs7W7Ozs5qYmNDExITev3+v/v5+9fX1qb+/f8FjevPmTdXW1rIG
+IZDFN9gbNmyQ1+uV1+uVx+MxXlAjIyNqbGzU3bt39fPnz3n9vytXrlQwGJTT6SQQThQm/ohIamqq
+VVlZaXV1dUXtPT98+GCVlZXNe7n4fD6OYnGYN7GDnZ6ebtXU1FhjY2Mxed9IJGLV19fPa7kUFRUR
+CIEkZrAdDod15syZmIXxf7W1tfNaNqOjowSygBdHseZh7969GhgY0IMHD5Sfnx+X97xx44Z2795t
+PF93dzcLjMO88TvHcP/+ffX19WnXrl3xXVApKbp9+7bxfSFv3rxhwRFI7B07dkxDQ0Oqrq5O2P9Q
+XFysffv2Gc0zOjrKwiOQ2Hv69Kny8vIS/n8cP37caPqxsTEWHoHYa//HxPfv3xk0ArGP1atXG03/
+7z3vIBBbyM3NNZo+KyuLQSMQ+5icnDSaPicnh0EjEPsYHh42mp7L3gnEVnp6eoymLyoqYtAIxD4e
+PXpkNP3+/fsZtAXgcvclpL29XUeOHPnj6Z1Op8bHx7Vs2TJ7fri5o9A+ZmZmdPHiRaN5vF6vbeNg
+E8tmGhoaNDQ0ZPTteeHCBQaOQJLfkydPdP36daN5Tp48qc2bNzN47IMkt9evX+vw4cOanp7+43ly
+cnI0PDy8KK4dYx8EMRMIBHT06FGjOCTJ5/PZPg42sZJce3u7Dh06pB8/fhjNV11dndBL8tnEYhMr
+5lpaWuT1evX792+j+YqLixUIBLj+ik2s5NXc3KwTJ04Yx5Gfn69nz54RB5tYyaupqUlVVVWanZ01
+ms/tdqujo4P9DgJJXg8fPtSpU6cUDoeN43j58qUKCwsZRAJJTvfu3dPZs2eNf0/X7Xarq6tL27dv
+ZxAJJDn5fD7V1NQYx7FmzRq9evVK27ZtYxAJJDk1NDSorq7O+ChgQUGBent7tWXLFgYxxniecILU
+1dXJ5/MZz7d161a9ePHC+N50sAZZMq5cuTKvOEpKStTT00McccSJwji7devWvJ7bceDAAbW2ttr6
+cQbGH26eD7K0BAIBlZeXG5/nqKioUEtLizIyMhhEAklOX758kcfj0adPn4zXHG1tbcSRoEDYB4mT
+y5cvG8exZ88etba2Egf7IMnt7du32rFjh9G5jvz8fA0MDBj/UBxYgyw5jY2NRnGkpqaqubmZOBYB
+AomxmZkZPX782Gie+vr6uD9/BGxiJURvb69KS0v/ePrMzEyFQiG5XC4Gj02s5BcIBIymr6ysJA42
+sezj3bt3RtObPv8DBLKkBYNBo+m5r4NAbCUUChlNv379egaNQOzD9FdJ2P8gEFsxfQQaFyMuLhzm
+jfUAG45tOBw2fhY6ojP2rEGWwiqdONjEAggEIBCAQAACAUAgAIEA0cIPx8UYJ1FZgwAEAhAIAAIB
+CAQgEIBAAAIBFiNOFMaY6V1tnFhkDQIQCEAgAIEABAKAQAACAQgEIBCAQAACAQgEIBCAQABIXO4e
+c1y+zhoEIBCAQAAQCEAgAIEABAIQCEAgAIEABAIQCEAgAAgEIBCAQAACAQgEIBCAQAACAQgEAIEA
+BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA
+fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=")
+ "The PNG data for a generic 200x200 \"broken image\" view.")
+
+(defvar mastodon-media--sensitive-image-data
+ (base64-decode-string
+ "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAA6npUWHRSYXcgcHJvZmlsZSB0eXBl
+IGV4aWYAAHjajVHbjcQwCPx3FVcCr/hRjvOSroMtfyc2Ts4rrXRIxjAQPEzC8fo9w89lkiXYknIs
+MRLMihWpCDJ1W5tnsuabbaPGMx7uggBS3NrTIo4fwBGz58X7efSPQSPgimh5CrU6vs746gMlfw5y
+Bsr9Zdr9Ax+k4oxsXi2WnKbV9o1my88xTRKXyMngTSilWBBnIUvQc7+InpuUNmjpgt7AyEergJMc
+ykrwqtZZ6nVMK+7YvAU0skMMb9qFJ/xKUADz4g9VusX8q82j0Rf7z1rhDfqGdxgpcULlAAABhWlD
+Q1BJQ0MgcHJvZmlsZQAAeJx9kT1Iw0AcxV8/tKJVBzuIOGSoTnZREd1qFYpQIdQKrTqYXPohNGlI
+UlwcBdeCgx+LVQcXZ10dXAVB8APE2cFJ0UVK/F9SaBHjwXE/3t173L0D/PUyU81gHFA1y0gnE0I2
+tyKEXtGJIHowgz6JmfqsKKbgOb7u4ePrXYxneZ/7c/QqeZMBPoE4znTDIl4nntq0dM77xBFWkhTi
+c+Ixgy5I/Mh12eU3zkWH/TwzYmTSc8QRYqHYxnIbs5KhEk8SRxVVo3x/1mWF8xZntVxlzXvyF4bz
+2vIS12kOI4kFLEKEABlVbKAMCzFaNVJMpGk/4eEfcvwiuWRybYCRYx4VqJAcP/gf/O7WLEyMu0nh
+BNDxYtsfI0BoF2jUbPv72LYbJ0DgGbjSWv5KHZj+JL3W0qJHQP82cHHd0uQ94HIHGHzSJUNypABN
+f6EAvJ/RN+WAgVuge9XtrbmP0wcgQ12lboCDQ2C0SNlrHu/uau/t3zPN/n4Ag31yra/8+kkAAA14
+aVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8P3hwYWNrZXQgYmVnaW49Iu+7vyIgaWQ9Ilc1TTBN
+cENlaGlIenJlU3pOVGN6a2M5ZCI/Pgo8eDp4bXBtZXRhIHhtbG5zOng9ImFkb2JlOm5zOm1ldGEv
+IiB4OnhtcHRrPSJYTVAgQ29yZSA0LjQuMC1FeGl2MiI+CiA8cmRmOlJERiB4bWxuczpyZGY9Imh0
+dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogIDxyZGY6RGVzY3Jp
+cHRpb24gcmRmOmFib3V0PSIiCiAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94
+YXAvMS4wL21tLyIKICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
+c1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2Vs
+ZW1lbnRzLzEuMS8iCiAgICB4bWxuczpHSU1QPSJodHRwOi8vd3d3LmdpbXAub3JnL3htcC8iCiAg
+ICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht
+cD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgeG1wTU06RG9jdW1lbnRJRD0iZ2lt
+cDpkb2NpZDpnaW1wOmYyYjU4MzUwLTc3ZWMtNDAxNC1hNDVlLTE1N2QyZjljOGM5NyIKICAgeG1w
+TU06SW5zdGFuY2VJRD0ieG1wLmlpZDowOTk5MzZhMi1jOGM5LTRkYTAtYTI0Yi02YTM1MmUyNmNi
+NmUiCiAgIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDphMDliYmZhMi03MzA2LTQ3
+NWQtOGExNC05YzA3ZTE1NmFiMTYiCiAgIGRjOkZvcm1hdD0iaW1hZ2UvcG5nIgogICBHSU1QOkFQ
+ST0iMi4wIgogICBHSU1QOlBsYXRmb3JtPSJMaW51eCIKICAgR0lNUDpUaW1lU3RhbXA9IjE3MTc1
+MDI1MDIzNDQ1NzIiCiAgIEdJTVA6VmVyc2lvbj0iMi4xMC4zNCIKICAgdGlmZjpPcmllbnRhdGlv
+bj0iMSIKICAgeG1wOkNyZWF0b3JUb29sPSJHSU1QIDIuMTAiCiAgIHhtcDpNZXRhZGF0YURhdGU9
+IjIwMjQ6MDY6MDRUMTQ6MDE6NDArMDI6MDAiCiAgIHhtcDpNb2RpZnlEYXRlPSIyMDI0OjA2OjA0
+VDE0OjAxOjQwKzAyOjAwIj4KICAgPHhtcE1NOkhpc3Rvcnk+CiAgICA8cmRmOlNlcT4KICAgICA8
+cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0ic2F2ZWQiCiAgICAgIHN0RXZ0OmNoYW5nZWQ9Ii8i
+CiAgICAgIHN0RXZ0Omluc3RhbmNlSUQ9InhtcC5paWQ6NTRmM2I5NDktOTlkMS00Mzk2LWI2NzIt
+Y2ZkYjRlZWFiYTA1IgogICAgICBzdEV2dDpzb2Z0d2FyZUFnZW50PSJHaW1wIDIuMTAgKExpbnV4
+KSIKICAgICAgc3RFdnQ6d2hlbj0iMjAyNC0wNi0wNFQxNDowMTo0MiswMjowMCIvPgogICAgPC9y
+ZGY6U2VxPgogICA8L3htcE1NOkhpc3Rvcnk+CiAgPC9yZGY6RGVzY3JpcHRpb24+CiA8L3JkZjpS
+REY+CjwveDp4bXBtZXRhPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAg
+ICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6w3d0DAAAABmJLR0QA/wD/AP+gvaeTAAAA
+CXBIWXMAAC4jAAAuIwF4pT92AAAAB3RJTUUH6AYEDAEq/VtQSwAAABl0RVh0Q29tbWVudABDcmVh
+dGVkIHdpdGggR0lNUFeBDhcAAAtOSURBVHja7dvbT5R3Hsfxz5xwhtOsjkgFGQZRTlFOCjJSkpVe
+YFltmpZNuo3t9qLdu/4Pa/+L3jVZL9pEU2q7aGirEkUkWw+IM5SpOELxgICcUXjmsBfKBOooo2Za
+3H2/Ei+EeRif74/3c5gnmj47fDgqAHGZGQFAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEI
+BCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgEAAAgEIBCAQgEAAAgFA
+IACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEIBCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAjw
+CrIm+w0ikYiCwaB8Pp8GBweVk5OjoqIiOZ1OjY+Pq6qq6g8fwuLiov7d1qbFhQUdOHhQaampSd0O
+BBLT2dmp8+fP6/3331dzc7Oi0ahu3bql1tZW7dixY00MIRqNKhQKyWyxyPQ7bAcCkSSNjY3p7Nmz
+anzjDeXl5cW+7vF41NLSos7OzjUxhHXr1umvLS2/23bgHkSSNDk5+ahC65Md5uTkaMuyaID/u0BS
+UlIkSd0XLmhubu6J73vr6tb8gO7fv69gMMhvyhqfV7LeN6mBZGdnKysrS1NTU2r95htNTU29Uou9
+uLiojo4OhUIhfvPX8LyS+b6mzw4fjibzHz8+Pq6jx45pfGxMqamp+suBA9pWWCiTKf5tbSgU0vXr
+1+X3+3Xnzh1t2bJFFRUV8ng8kqSBgQF99dVXkiTXxo36xyefaGBgQD6/X0ODg8rNzVVdXZ1ycnJW
+DNDn86nv55/1YH5excXF8nq9slgsikajmpiY0PDwsPx+v5qbm5WZmamJiQmdOHlSN4NB2Ww2paWn
+a252Vk1NTSovL3/qdsePH1dfX5/WrVsnm82mSCSiAwcOqKCgQF1dXeru7pbNZpNhGCoqKlJzc3NC
++53oJW0gEND1gQGNjY4qNzdXZWVlKikpic07EolocHBQgUBAwWBQVqtVnoICFW3frry8vNjrnnfO
+q80rWeub6Pu+KMu+ffv+mcxAUlNTVVxUpLm5Od2+fVt+n0/z8/PavHlz7BJsiWEYOnXqlDwej6qr
+q1VVVaUHDx+qtbVVm7KztdHlktPp1I4dOxQIBDQ5OSmTySSXy6Vd1dWqrKxU8OZNnTl9Wrt27Yrd
++5w5c0YOh0NvNDYqPz9f7e3tqq6ultVq1YMHD+T3+3X+/HmNjIyourpaDodDDodDmzZt0uXLl/XO
+O+9o//79qq+vV3Z2tiQ9dbvCwkLl5ubqypUrcjqd+vjjj+VyuSRJW7ZsUVlZmX755Rft3r1bDQ0N
+MpvNCe33avoDAXV0dKi2pkY1u3erpLRU83Nz8vv9Ki4ultVq1eLiotrb2zU8PKz6+nrt3btXZWVl
+j87wra0yDENut1tms/m557zavJK1vom875q9xFqSkZGhgwcP6t1335XdbtelS5f0xRdf6N69eyte
+19PTo/T0dL322muyWCxKSUlRdVWVcnJzdaKtTXNzc7JYLHK5XMrKypLNZtOePXvkdrtjw6qsqJBh
+GLo3Oho7e3R3dys9I0MWi0UbN25UQ0ODotFoLOC6ujo1NDQ8eXp9fDQ1m81xw4+3ndVqVWFhocrL
+y3Xv3r0V914mk0l2u102m01VVVWyWCwJ7/ezDA0N6djRo3pz/365XC6ZzWb9yenU66+/rg8++EB2
+u12SdOHCBQUCATU1NWnDhg2yWCxKTU1VbW2tGhsb1d3drf/89NOjI+dzznm1eSVrfRN53zX7Me+K
+Es1mFRcXKycnR6dOnZLP59OXX36pjz76SJmZmVpYWNCPP/6ocDisjo6OuD/jRjConY+fnVgsltiQ
+l3M4HLEj/NLrsrOz9e3x42ppaZHb7Y77cNJifbFRPG276upqXb16VYFAQLW1tbGvDwwMaE9dXezs
+9rz7/VuRSEQ//PCDamtrtWHDhqf+O2dmZnTu3DnVeb1KS0t74vuVlZU6e/asTp86pfKdO2OvSXTO
+q0nW+ibb7xbI8rNJc3OzZDLJd+2aenp61NDQoKmpKYXDYR06dEhut1vRaDR2lF86SjztviXeUT8S
+DscG/fbbb+vosWM6cuSIvF6v9uzZo9QkP/XevHmztm/fro6ODu0sL5fDblcoFNJPFy/qb++9F3vd
+y+735OSk7t69q5plEcaz9AFJZkZG3O/b7Xbt2LlTly9d0vT0dNyInjXn1SRrfV/pj3mnp6cViUSe
++LrNZtNer1eS1HvtWuz6dPkATCaTzGZz7E8iw5MUG/ryZy8ul0t///BD7WtsVFdXl/515IhmZmaS
+OliTyaSamhoZhqEbAwOxS6GqykrZbLYV1+Uvs98PHz58tJAJzmd2dvbpB6/09IT3L96cnyWZ6/vK
+BjI4NPTEfcaStMeLsbQo6x5fJ48uu7Z8EeHHR5blv4ThcFh2u13eujodOnRI42Njunr1asI/MxJ9
+sQ/68vLylJObq3OdnVpcXNTFixe1bdu2Fa952f1eugQZGxt75uucTuejA1Jvb+yXNd6zBEnKzMx8
+oTk/a17JXN+XXac/LJBUh0NdXV1xP58ef7ygFRUVkqQN69fLnZ+vzs7OuEe5Bw8famJiYsXfw3FO
+s4uLiyuOMAsLC7p0+XLs+263W6VlZU9su3SmW37aX7qJfjA/v+KsuPw18bZbvv1er1fjY2P6/vvv
+lZ+fH7uGXvK8+/1b69ev1+acHHV2dsZ9znT37l3Nzs4qIyND9fX1mpmZkc/ni3updu3aNf15374V
+l1eJznm1eSVrfRNdpzUZSHp6uvr6+vTtd99pZGREoVBIhmFoeHhYJ0+eVEVFhUpLS2M38fubmhQO
+h/XN8eMaGRlROBxWKBTSnTt3dDMYjB0FZ2ZmNPzrrzIMY8WlkmEYGhwcjIURjUZltVp15vRp3b59
+W5FIRGNjYxq8eVNFRUUrbiBHRkZig10KOjMzU66NG+Xz+zU/P6/Z2Vn19vauut1yHo9HTqdTPT09
+KikpifvhRaL7HfdDAotFb+7fL5vNphMnTmh0dFSRSESGYSgYDOr+/ftKf3yW9nq9qqysVFtbm65c
+uRL7JRwdHVXbiRPaXVOj2pqaFTf2ic55tXkla30TWac1+6BwYWFBP/f3y5mZqVu3bmngxg3NTE/L
+4/GoqLhYWwsKYvUvL7+3t1d9fX2ypaRoa0GBSkpKlJWVJUnq6+vT119/vWKbt956S263W59//nns
+5xmGIYfDoU8//VTt7e1KS0tTf3+/srKytGvXLuXm5kqSgsGg2tralJKSonA4LMMw5PF4dPDgwUeX
+LuPjOt/ZqZGREe0sL1d1VZVSUlJW3W45n9+vyYkJ1dfXP/N+7Vn7vZqJiQn19vaqv79fZrNZhYWF
+Ki0tfeJ5QCQS0dDQkAKBgG7cuCFJ2rp1q4qKimLPQF50ziaT6anzSub6JvK+a/ZJejIsfQKy/IYP
+/ztzXkvra30VFy7RjwTxas55La0v/+UWIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQ
+CEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCA
+QAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCA
+QAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEA
+BAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAQgEAIEABAIQCEAgAIEABAIQCEAgAIEA
+IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==")
+ "The PNG data for a sensitive image placeholder.")
+
+(defun mastodon-media--process-image-response
+ (status-plist url marker image-options region-length)
+ "Callback function processing the url retrieve response for URL.
+STATUS-PLIST is the usual plist of status events as per `url-retrieve'.
+IMAGE-OPTIONS are the precomputed options to apply to the image.
+MARKER is the marker to where the response should be visible.
+REGION-LENGTH is the length of the region that should be replaced
+with the image."
+ (when (marker-buffer marker) ; if buffer hasn't been killed
+ (let ((url-buffer (current-buffer))
+ (is-error-response-p (eq :error (car status-plist))))
+ (let* ((data (unless is-error-response-p
+ (goto-char (point-min))
+ (and (search-forward "\n\n" nil t)
+ (buffer-substring (point) (point-max)))))
+ (image (when data
+ (apply #'create-image data ;; inbuilt scaling in 27.1:
+ (when (version< emacs-version "27.1")
+ (when image-options 'imagemagick))
+ t image-options))))
+ (when mastodon-media--enable-image-caching
+ (unless (url-is-cached url) ; cache if not already cached
+ (url-store-in-cache url-buffer)))
+ (with-current-buffer (marker-buffer marker)
+ ;; Save narrowing in our buffer
+ (let ((inhibit-read-only t))
+ (save-restriction
+ (widen)
+ (put-text-property marker
+ (+ marker region-length) 'media-state 'loaded)
+ (when image
+ ;; We only set the image to display if we could load
+ ;; it; we already have set a default image when we
+ ;; added the tag.
+ (mastodon-media--display-image-or-sensitive
+ marker region-length image))
+ ;; We are done with the marker; release it:
+ (set-marker marker nil)))
+ (kill-buffer url-buffer))))))
+
+(defun mastodon-media--display-image-or-sensitive (marker region-length image)
+ "Display image using display property, or add sensitive mask.
+MARKER, REGION-LENGTH and IMAGE are from
+`mastodon-media--process-image-response'.
+If the image is marked sensitive, the image is stored in
+image-data prop so it can be toggled."
+ (if (or (not (eq t (get-text-property marker 'sensitive)))
+ (not mastodon-media--hide-sensitive-media))
+ ;; display image
+ (put-text-property marker (+ marker region-length)
+ 'display image)
+ ;; display sensitive placeholder and save image data as prop:
+ (add-text-properties marker (+ marker region-length)
+ `(display
+ ;; (image :type png :data ,mastodon-media--sensitive-image-data)
+ ,(create-image
+ mastodon-media--sensitive-image-data nil t)
+ sensitive-state hidden image-data ,image))))
+
+(defvar mastodon-media--attachments nil
+ "A list attachment details for full sized image view buffer.
+The first element is the URL of the image displayed, followed by plists
+of details of all of a toot's attachments.")
+
+(defun mastodon-media--process-full-sized-image-response
+ (status-plist url attachments &optional prev-buf)
+ ;; FIXME: refactor this with but not into
+ ;; `mastodon-media--process-image-response'.
+ "Callback function processing the `url-retrieve' response for URL.
+URL is a full-sized image URL attached to a timeline image.
+STATUS-PLIST is a plist of status events as per `url-retrieve'."
+ (if-let* ((error-response (plist-get status-plist :error)))
+ (user-error "error in loading image: %S" error-response)
+ (when mastodon-media--enable-image-caching
+ (unless (url-is-cached url) ;; cache if not already cached
+ (url-store-in-cache)))
+ ;; thanks to rahguzar for this idea:
+ ;; https://codeberg.org/martianh/mastodon.el/issues/540
+ (let* ((handle (mm-dissect-buffer t))
+ (image (mm-get-image handle))
+ (str (image-property image :data))
+ (buf "*masto-image*"))
+ (with-current-buffer (get-buffer-create buf)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert-image image str)
+ (special-mode) ; prevent image-mode loop bug
+ (mastodon-image-mode) ;; for our keymap
+ (goto-char (point-min))
+ (image-transform-fit-both)
+ ;; set image metadata for view cycling:
+ (setq-local mastodon-media--attachments (cons url attachments))))
+ ;; switch to buf if not already viewing it:
+ (unless (equal buf prev-buf)
+ (switch-to-buffer-other-window buf))
+ ;; display bindings if multiple images:
+ (when (< 1 (length (cdr mastodon-media--attachments)))
+ (message (substitute-command-keys
+ "\\`.'/\\`>'/\\`<right>' to cycle images"))))))
+
+(defun mastodon-media--image-or-cached (url process-fun args)
+ "Fetch URL from cache or fro host.
+Call PROCESS-FUN on it with ARGS, a list of callback args as
+specified by `url-retrieve'."
+ (if (and mastodon-media--enable-image-caching
+ (url-is-cached url)) ;; if cached, decompress and use:
+ (with-current-buffer (url-fetch-from-cache url)
+ (set-buffer-multibyte nil)
+ (goto-char (point-min))
+ (zlib-decompress-region
+ (goto-char (search-forward "\n\n")) (point-max))
+ (apply process-fun args)) ;; no status-plist arg from cache
+ ;; fetch as usual and process-image-response will cache it:
+ ;; cbargs fun will be called with status-plist by url-retrieve:
+ (url-retrieve url process-fun (cdr args))))
+
+(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'.
+START is the position where we start loading the image.
+REGION-LENGTH is the range from start to propertize."
+ (let ((image-options
+ (when (mastodon-tl--image-trans-check)
+ (cond ((eq media-type 'avatar)
+ `(:height ,mastodon-media--avatar-height))
+ ((eq media-type 'media-link)
+ `(:max-height ,mastodon-media--preview-max-height)))))
+ (buffer (current-buffer))
+ (marker (copy-marker start))
+ (url-show-status nil)) ; stop url.el from spamming us about connecting
+ (condition-case nil
+ ;; catch errors in url-retrieve to not break our caller
+ (mastodon-media--image-or-cached
+ url
+ #'mastodon-media--process-image-response
+ (list nil url marker image-options region-length))
+ (error (with-current-buffer buffer
+ ;; TODO: Add retries
+ (put-text-property marker (+ marker region-length)
+ 'media-state 'loading-failed)
+ :loading-failed)))))
+
+(defun mastodon-media--select-next-media-line (end-pos)
+ "Find coordinates of the next media to load before END-POS.
+Returns the list of (`start' . `end', `media-symbol') points of
+that line and string found or nil no more media links were
+found."
+ (let ((next-pos (point)))
+ (while
+ (and
+ (setq next-pos (next-single-property-change next-pos 'media-state))
+ (or (not (eq 'needs-loading (get-text-property next-pos 'media-state)))
+ (null (get-text-property next-pos 'media-url))
+ (null (get-text-property next-pos 'media-type))))
+ ;; do nothing - the loop will proceed
+ )
+ (when (and next-pos (< next-pos end-pos))
+ (let ((media-type (get-text-property next-pos 'media-type)))
+ (cond
+ ((eq media-type 'avatar) ; avatars are one character
+ (list next-pos (+ next-pos 1) 'avatar))
+ ((eq media-type 'media-link) ; media links are 5 characters: [img]
+ (list next-pos (+ next-pos 5) 'media-link)))))))
+
+(defun mastodon-media--valid-link-p (link)
+ "Check if LINK is valid.
+Checks to make sure the missing string has not been returned."
+ (and link
+ (> (length link) 8)
+ (or (string= "http://" (substring link 0 7))
+ (string= "https://" (substring link 0 8)))))
+
+(defun mastodon-media--inline-images (search-start search-end)
+ "Find all `Media_Links:' in the range from SEARCH-START to SEARCH-END.
+Replace them with the referenced image."
+ (save-excursion
+ (goto-char search-start)
+ (let (line-details)
+ (while (setq line-details
+ (mastodon-media--select-next-media-line search-end))
+ (let* ((start (car line-details))
+ (end (cadr line-details))
+ (media-type (cadr (cdr line-details)))
+ (type (get-text-property start 'mastodon-media-type))
+ (image-url (get-text-property start 'media-url)))
+ (if (not (mastodon-media--valid-link-p image-url))
+ ;; mark it at least as not needing loading any more
+ (put-text-property start end 'media-state 'invalid-url)
+ ;; proceed to load this image asynchronously
+ (put-text-property start end 'media-state 'loading)
+ (mastodon-media--load-image-from-url
+ image-url media-type start (- end start))
+ (when (or (string= type "gifv")
+ (string= type "video"))
+ (mastodon-media--moving-image-overlay start end))))))))
+
+;; (defvar-local mastodon-media--overlays nil
+;; "Holds a list of overlays in the buffer.")
+
+(defun mastodon-media--moving-image-overlay (start end)
+ "Add play symbol overlay to moving image media items.
+START and END are the beginning and end of the media item to overlay."
+ (let ((ov (make-overlay start end)))
+ (overlay-put
+ ov
+ 'after-string
+ (propertize ""
+ 'help-echo "Video"
+ 'face
+ '((:height 3.5 :inherit mastodon-toot-docs-face))))))
+;; (cl-pushnew ov mastodon-media--overlays)))
+
+(defun mastodon-media--get-avatar-rendering (avatar-url)
+ "Return the string to be written that renders the avatar at AVATAR-URL."
+ ;; We use just an empty space as the textual representation.
+ ;; This is what a user will see on a non-graphical display
+ ;; where not showing an avatar at all is preferable.
+ (let ((image-options (when (mastodon-tl--image-trans-check)
+ `(:height ,mastodon-media--avatar-height))))
+ (concat
+ (propertize " "
+ 'media-url avatar-url
+ 'media-state 'needs-loading
+ 'media-type 'avatar
+ 'display
+ (apply #'create-image mastodon-media--generic-avatar-data
+ ;; inbuilt scaling in 27.1
+ (when (version< emacs-version "27.1")
+ (when image-options 'imagemagick))
+ t image-options))
+ " ")))
+
+(defun mastodon-media--get-media-link-rendering
+ (media-url &optional full-remote-url type caption sensitive)
+ "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.
+CAPTION is the image caption if provided.
+SENSITIVE is a flag from the item's JSON data."
+ (let* ((help-echo-base
+ (substitute-command-keys
+ (concat "\\`RET': load full image or play video,\
+ \\`i' for image options"
+ (when (not (eq sensitive :json-false))
+ ", \\`S': toggle sensitive media"))))
+ (help-echo (if caption
+ (concat help-echo-base
+ "\n\"" caption "\"")
+ help-echo-base)))
+ (concat
+ (mastodon-tl--propertize-img-str-or-url
+ "[img]" media-url full-remote-url type help-echo
+ (create-image mastodon-media--generic-broken-image-data nil t)
+ nil caption sensitive)
+ " ")))
+
+(provide 'mastodon-media)
+;;; mastodon-media.el ends here
--- /dev/null
+;;; mastodon-notifications.el --- Notification functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-notification.el provides notification functions for Mastodon.
+
+;;; Code:
+
+(require 'subr-x)
+(require 'cl-lib)
+(require 'mastodon-widget)
+(require 'map)
+
+(declare-function alert-add-rule "alert")
+(declare-function alert "alert")
+
+(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--buffer-type-eq "mastodon-tl")
+(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--property "mastodon-tl")
+(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl")
+(autoload 'mastodon-tl--spoiler "mastodon-tl")
+(autoload 'mastodon-tl--item-id "mastodon-tl")
+(autoload 'mastodon-tl-update "mastodon-tl")
+(autoload 'mastodon-views-view-follow-requests "mastodon-views")
+(autoload 'mastodon-tl--current-filters "mastodon-views")
+(autoload 'mastodon-tl--render-text "mastodon-tl")
+(autoload 'mastodon-notifications-get "mastodon")
+(autoload 'mastodon-tl--byline-uname-+-handle "mastodon-tl")
+(autoload 'mastodon-tl--byline-handle "mastodon-tl")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-media--get-avatar-rendering "mastodon-media")
+(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
+(autoload 'mastodon-tl--symbol "mastodon-tl")
+(autoload 'mastodon-tl--display-or-uname "mastodon-tl")
+(autoload 'mastodon-tl-goto-next-item "mastodon-tl")
+(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl")
+(autoload 'mastodon-tl--buffer-property "mastodon-tl")
+(autoload 'mastodon-http--patch "mastodon-http")
+(autoload 'mastodon-views--minor-view "mastodon-views")
+(autoload 'mastodon-tl--goto-first-item "mastodon-tl")
+(autoload 'mastodon-tl--init-sync "mastodon-tl")
+(autoload 'mastodon-http--get-json-async "mastodon-http")
+(autoload 'mastodon-live-buffers "mastodon")
+(autoload 'mastodon-tl--update "mastodon-tl")
+(autoload 'mastodon-tl--insert-quoted "mastodon-tl")
+
+;; notifications defcustoms moved into mastodon.el
+;; as some need to be available without loading this file
+
+(defvar mastodon-tl--shr-map-replacement)
+(defvar mastodon-tl--horiz-bar)
+(defvar mastodon-active-user)
+(defvar mastodon-instance-url)
+(defvar mastodon-tl--buffer-spec)
+(defvar mastodon-tl--display-media-p)
+(defvar mastodon-mode-map)
+(defvar mastodon-tl--fold-toots-at-length)
+(defvar mastodon-tl--show-avatars)
+(defvar mastodon-profile-note-in-foll-reqs)
+(defvar mastodon-profile-note-in-foll-reqs-max-length)
+(defvar mastodon-group-notifications)
+(defvar mastodon-notifications-grouped-names-count)
+(defvar mastodon-tl--link-keymap)
+(defvar mastodon-tl--update-point)
+(defvar mastodon-notifications-alerts-interval)
+(defvar mastodon-notifications-alert-style)
+(defvar mastodon-notifications-alerts)
+;;; VARIABLES
+
+(defvar mastodon-notifications--map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map mastodon-mode-map)
+ (define-key map (kbd "a") #'mastodon-notifications-follow-request-accept)
+ (define-key map (kbd "j") #'mastodon-notifications-follow-request-reject)
+ (define-key map (kbd "C-k") #'mastodon-notifications-clear-current)
+ (define-key map (kbd "C-c C-c") #'mastodon-notifications-cycle-type)
+ map)
+ "Keymap for viewing notifications.")
+
+(defvar mastodon-notifications--types
+ '("all" "favourite" "reblog" "mention" "poll"
+ "follow_request" "follow" "status" "update"
+ "severed_relationships" "moderation_warning" "quote"
+ "quoted_update")
+ "A list of notification types according to their name on the server, plus \"all\".")
+
+(defvar mastodon-notifications--filter-types-alist
+ '(("all" . mastodon-notifications-get)
+ ("favourite" . mastodon-notifications-get-favourites)
+ ("reblog" . mastodon-notifications-get-boosts)
+ ("mention" . mastodon-notifications-get-mentions)
+ ("poll" . mastodon-notifications-get-polls)
+ ("follow_request" . mastodon-notifications-get-follow-requests)
+ ("follow" . mastodon-notifications-get-follows)
+ ("status" . mastodon-notifications-get-statuses)
+ ("update" . mastodon-notifications-get-edits)
+ ("quote" . mastodon-notifications-get-quotes)
+ ("quoted_update" . mastodon-notifications-get-quoted-updates))
+ "An alist of notification types and their corresponding load functions.
+Notification types are named according to their name on the server.")
+
+(defvar mastodon-notifications--response-alist
+ '(("Followed" . "you")
+ ("Favourited" . "your post")
+ ("Boosted" . "your post")
+ ("Mentioned" . "you")
+ ("Posted a poll" . "that has now ended")
+ ("Requested to follow" . "you")
+ ("Posted" . "a post")
+ ("Edited" . "their post")
+ ("Quoted" . "your post")
+ ;; FIXME: this is very annoying, but because "Edited" is used above,
+ ;; we cannot reuse it here. I think this is because we use
+ ;; `mastodon-notifications--action-alist' to go from (server) notif
+ ;; type, to a string, and then use that string to get the rest of the
+ ;; byline string from `mastodon-notifications--response-alist' here.
+ ;; Ideally would just key the two strings according to notif type,
+ ;; even if they did need to be gathered separately and combined.
+ ("Modified" . "a post that you quoted"))
+ "Alist of subjects for notification types.")
+
+(defvar mastodon-notifications--action-alist
+ '((reblog . "Boosted")
+ (favourite . "Favourited")
+ (follow_request . "Requested to follow")
+ (follow . "Followed")
+ (mention . "Mentioned")
+ (status . "Posted")
+ (poll . "Posted a poll")
+ (update . "Edited")
+ (severed_relationships . "Relationships severed")
+ (moderation_warning . "Moderation warning")
+ (quote . "Quoted")
+ (quoted_update . "Modified"))
+ "Action strings keyed by notification type.
+Types are those of the Mastodon API.")
+
+(defvar mastodon-notifications--no-status-notif-alist
+ '(("moderation_warning" . moderation_warning)
+ ("severed_relationships" . event)
+ ("follow" . follow)
+ ("follow_request" . follow_request)))
+
+;;; VAR FETCHERS
+
+(defun mastodon-notifications--action-alist-get (type)
+ "Return an action string for notification TYPE.
+Fetch from `mastodon-notifications--action-alist'.
+If no match, return empty string."
+ (or (alist-get type mastodon-notifications--action-alist)
+ ""))
+
+(defun mastodon-notifications--response-alist-get (message)
+ "Return a response string for MESSAGE.
+Fetch from `mastodon-notifications--response-alist'.
+If no match, return empty string."
+ (or (alist-get
+ message
+ mastodon-notifications--response-alist nil nil #'equal)
+ ""))
+
+;;; UTILS
+
+(defun mastodon-notifications--api (endpoint)
+ "Return a notifications API ENDPOINT.
+If `mastodon-group-notifications' is non-nil, use API v2."
+ (mastodon-http--api endpoint
+ (when mastodon-group-notifications "v2")))
+
+;;; FOLL REQS
+
+(defun mastodon-notifications--follow-request-process (&optional reject)
+ "Process the follow request at point.
+With no argument, the request is accepted. Argument REJECT means
+reject the request. Can be called in notifications view or in
+follow-requests view."
+ (if (not (mastodon-tl--find-property-range 'item-json (point)))
+ (user-error "No follow request at point?")
+ (let* ((item-json (mastodon-tl--property 'item-json))
+ (f-reqs-view-p (string= "follow_requests"
+ (plist-get mastodon-tl--buffer-spec 'endpoint)))
+ (f-req-p (or (string= "follow_request"
+ (mastodon-tl--property 'notification-type
+ :no-move))
+ f-reqs-view-p)))
+ (if (not f-req-p)
+ (user-error "No follow request at point?")
+ (let-alist (or (alist-get 'account item-json) ;notifs
+ item-json) ;f-reqs
+ (if (not .id)
+ (user-error "No account result at point?")
+ (let ((response
+ (mastodon-http--post
+ (mastodon-http--api
+ (format "follow_requests/%s/%s"
+ .id (if reject "reject" "authorize"))))))
+ (mastodon-http--triage
+ response
+ (lambda (_)
+ (if f-reqs-view-p
+ (mastodon-views-view-follow-requests)
+ (mastodon-tl--reload-timeline-or-profile))
+ (message "Follow request of %s (@%s) %s!"
+ .username .acct (if reject "rejected" "accepted")))))))))))
+
+(defun mastodon-notifications-follow-request-accept ()
+ "Accept a follow request.
+Can be called in notifications view or in follow-requests view."
+ (interactive)
+ (mastodon-notifications--follow-request-process))
+
+(defun mastodon-notifications-follow-request-reject ()
+ "Reject a follow request.
+Can be called in notifications view or in follow-requests view."
+ (interactive)
+ (mastodon-notifications--follow-request-process :reject))
+
+;;; FORMAT NON-STANDARD NOTIFS
+
+(defun mastodon-notifications--severance-body (json)
+ "Return a body for a severance notification JSON."
+ ;; https://docs.joinmastodon.org/entities/RelationshipSeveranceEvent/
+ (let-alist json
+ (concat .type ": "
+ .target_name
+ "\nRelationships affected: "
+ "\nFollowers: " (number-to-string .followers_count)
+ "\nFollowing: " (number-to-string .following_count))))
+
+(defun mastodon-notifications--mod-warning-body (json)
+ "Return a body for a moderation warning notification JSON."
+ ;; https://docs.joinmastodon.org/entities/AccountWarning/
+ (let-alist json
+ (concat .action ": \"" (string-trim .text) "\""
+ "\nStatuses: "
+ (mastodon-notifications--render-mod-status-links .status_ids)
+ "\nfor account: "
+ .target_account.acct
+ (if .appeal
+ (concat "\nYour appeal: \""
+ (alist-get 'text .appeal)
+ "\"")
+ "")
+ "\nMore info/appeal: "
+ (mastodon-notifications--render-mod-link .id))))
+
+(defun mastodon-notifications--propertize-link (url help-echo)
+ "Render a plain URL link with HELP-ECHO."
+ (propertize
+ url
+ 'face 'shr-link ;; mastodon-display-name-face
+ 'keymap mastodon-tl--shr-map-replacement
+ 'mastodon-tab-stop 'shr-url
+ 'help-echo help-echo
+ 'follow-link t
+ 'mouse-face 'highlight
+ 'shr-url url
+ 'keymap mastodon-tl--shr-map-replacement))
+
+(defun mastodon-notifications--render-mod-status-links (ids)
+ "Render moderation status IDS as URLs."
+ (mapconcat (lambda (id)
+ (let ((str (format "%s/@%s/%s"
+ mastodon-instance-url
+ mastodon-active-user id)))
+ (mastodon-notifications--propertize-link str "view toot")))
+ ids ", "))
+
+(defun mastodon-notifications--render-mod-link (id)
+ "Render a moderation link for item with ID."
+ (let ((str (format "%s/disputes/strikes/%s"
+ mastodon-instance-url id)))
+ (mastodon-notifications--propertize-link str "View mod warning")))
+
+;;; FORMAT/INSERT SINGLE NOTIF
+
+(defun mastodon-notifications--format-note (note)
+ "Format for a NOTE, a non-grouped notification."
+ (let* ((type (intern (alist-get 'type note)))
+ (profile-note
+ (when (eq 'follow_request type)
+ (let ((str (mastodon-tl--field
+ 'note
+ (mastodon-tl--field 'account note))))
+ (if mastodon-profile-note-in-foll-reqs-max-length
+ (string-limit str mastodon-profile-note-in-foll-reqs-max-length)
+ str))))
+ (status (mastodon-tl--field 'status note))
+ (follower (alist-get 'account note))
+ (follower-name (mastodon-notifications--follower-name follower))
+ (filtered (mastodon-tl--field 'filtered status))
+ (filters (when filtered
+ (mastodon-tl--current-filters filtered))))
+ (if (and filtered (assoc "hide" filters))
+ nil
+ (mastodon-notifications--insert-note
+ ;; toot
+ ;; should always be note, otherwise notif data not avail
+ ;; later on:
+ note
+ ;; body
+ (mastodon-notifications--body-arg
+ type filters status profile-note follower-name nil note)
+ ;; action-byline (top)
+ (mastodon-notifications--action-byline
+ type nil nil note follower-name)
+ ;; base toot (always provide)
+ status
+ nil nil nil type))))
+
+(defun mastodon-notifications--format-group-note (group status accounts)
+ "Format for a GROUP notification.
+STATUS is the status's JSON.
+ACCOUNTS is data of the accounts that have reacted to the notification."
+ (let ((folded nil))
+ ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot'
+ (let-alist group
+ (let* ((type (intern .type))
+ (profile-note
+ (when (member type '(follow_request))
+ (let ((str (mastodon-tl--field 'note (car accounts))))
+ (if mastodon-profile-note-in-foll-reqs-max-length
+ (string-limit str mastodon-profile-note-in-foll-reqs-max-length)
+ str))))
+ (follower (when (member type '(follow follow_request))
+ (car accounts)))
+ (follower-name (mastodon-notifications--follower-name follower))
+ (filtered (mastodon-tl--field 'filtered status))
+ (filters (when filtered
+ (mastodon-tl--current-filters filtered))))
+ (unless (and filtered (assoc "hide" filters))
+ (mastodon-notifications--insert-note
+ ;; toot
+ (if (member type '(follow follow_request))
+ follower
+ status)
+ ;; body
+ (mastodon-notifications--body-arg
+ type filters status profile-note follower-name group)
+ ;; action-byline
+ (mastodon-notifications--action-byline
+ type accounts group)
+ ;; base toot (no need for update/poll/?)
+ (when (member type '(favourite reblog))
+ status)
+ folded group accounts))))))
+
+(defun mastodon-notifications--follower-name (follower)
+ "Return display_name or username of FOLLOWER."
+ (if (not (string= "" (alist-get 'display_name follower)))
+ (alist-get 'display_name follower)
+ (alist-get 'username follower)))
+
+(defun mastodon-notifications--comment-note-text (str)
+ "Add comment face to all text in STR with `shr-text' face only."
+ (with-temp-buffer
+ (insert str)
+ (goto-char (point-min))
+ (let (prop)
+ (while (setq prop (text-property-search-forward 'face 'shr-text t))
+ (add-text-properties (prop-match-beginning prop)
+ (prop-match-end prop)
+ '(face (mastodon-toot-docs-face shr-text)))))
+ (buffer-string)))
+
+(defun mastodon-notifications--body-arg
+ (type &optional filters status profile-note follower-name group note)
+ "Prepare a notification body argument.
+The string returned is passed to `mastodon-notifications--insert-note'.
+TYPE is a symbol, a member of `mastodon-notifiations--types'.
+FILTERS STATUS PROFILE-NOTE FOLLOWER-NAME GROUP NOTE."
+ (let ((body
+ (if-let* ((match (assoc "warn" filters)))
+ (mastodon-tl--spoiler status (cadr match))
+ (mastodon-tl--clean-tabs-and-nl
+ (cond ((mastodon-tl--has-spoiler status)
+ (mastodon-tl--spoiler status))
+ ((eq type 'follow_request)
+ (mastodon-tl--render-text profile-note))
+ (t (mastodon-tl--content status)))))))
+ (cond
+ ((not (member (symbol-name type)
+ mastodon-notifications--types))
+ "Unknown notification type.")
+ ((eq type 'follow)
+ (propertize "Congratulations, you have a new follower!"
+ 'face 'default
+ 'item-type 'follow-request)) ;; nav
+ ((eq type 'follow_request)
+ (concat
+ (propertize (format "You have a follow request from %s"
+ follower-name)
+ 'face 'default
+ 'item-type 'follow-request) ;; nav
+ (when mastodon-profile-note-in-foll-reqs
+ (concat
+ ":\n"
+ (mastodon-notifications--comment-note-text body)))))
+ ((eq type 'severed_relationships)
+ (mastodon-notifications--severance-body
+ (alist-get 'event (or group note))))
+ ((eq type 'moderation_warning)
+ (mastodon-notifications--mod-warning-body
+ (alist-get 'moderation_warning (or group note))))
+ ((member type '(favourite reblog))
+ (propertize
+ (mastodon-notifications--comment-note-text body)))
+ (t body))))
+
+(defun mastodon-notifications--insert-note
+ (toot body action-byline
+ &optional base-toot unfolded group accounts type)
+ "Display the content and byline of timeline element TOOT.
+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 a string, obtained by calling
+`mastodon-notifications--action-byline'.
+BASE-TOOT is the JSON of the toot responded to.
+UNFOLDED is a boolean meaning whether to unfold or fold item if
+foldable.
+GROUP is the notification group data.
+ACCOUNTS is the notification accounts data.
+TYPE is notification type, used for non-group notifs."
+ (let* ((type (if type
+ (symbol-name type) ;; non-group
+ (alist-get 'type group)))
+ (toot-foldable
+ (and mastodon-tl--fold-toots-at-length
+ (length> body mastodon-tl--fold-toots-at-length)))
+ (ts ;; types listed here use base item timestamp, else we use
+ ;; group's latest timestamp:
+ (when (and group
+ (not
+ (member type '("favourite" "reblog" "edit" "poll"))))
+ (mastodon-tl--field 'latest_page_notification_at group))))
+ (insert
+ (propertize ;; top byline, body + byline:
+ (concat
+ (if (equal type "mention") ;; top (action) byline
+ ""
+ action-byline)
+ (propertize body ;; body only
+ 'toot-body t) ;; includes newlines etc. for folding
+ "\n"
+ ;; display quoted post:
+ (when (alist-get 'quote toot)
+ (mastodon-tl--insert-quoted (alist-get 'quote toot) toot))
+ ;; actual byline:
+ (if (member type '("severed_relationships" "moderation_warning"))
+ (propertize
+ (concat mastodon-tl--horiz-bar "\n")
+ 'byline t)
+ (mastodon-tl--byline toot nil nil base-toot group ts)))
+ 'item-type 'toot ;; for nav, actions, etc.
+ 'item-id (or (alist-get 'page_max_id group) ;; newest notif
+ (alist-get 'id toot)) ; toot id
+ 'base-item-id (mastodon-tl--item-id
+ ;; if status is a notif, get id from base-toot
+ ;; (-tl--item-id toot) will not work here:
+ (or base-toot
+ toot)) ; else normal toot with reblog check
+ 'item-json toot
+ 'base-toot base-toot
+ 'cursor-face 'mastodon-cursor-highlight-face
+ 'toot-foldable toot-foldable
+ 'toot-folded (and toot-foldable (not unfolded))
+ ;; grouped notifs data:
+ 'notification-type type
+ 'notification-id (alist-get 'group_key group)
+ 'notification-group group
+ 'notification-accounts accounts
+ ;; for pagination:
+ 'notifications-min-id (alist-get 'page_min_id group)
+ 'notifications-max-id (alist-get 'page_max_id group))
+ "\n")))
+
+;;; BYLINES
+
+(defun mastodon-notifications--action-byline
+ (type &optional accounts group note follower-name)
+ "Return an action (top) byline for notification of TYPE.
+ACCOUNTS and GROUP group are used by grouped notifications.
+NOTE and FOLLOWER-NAME are used for non-grouped notifs."
+ (let* ((str-prefix (mastodon-notifications--action-alist-get type))
+ (action-str
+ (unless (member type '(follow follow_request mention))
+ (downcase
+ (mastodon-notifications--byline-action-str
+ str-prefix))))
+ (action-symbol (if (eq type 'mention)
+ ""
+ (mastodon-tl--symbol type)))
+ (action-authors
+ (cond
+ ((not (member (symbol-name type)
+ mastodon-notifications--types))
+ "")
+ ((member type
+ '(follow follow_request mention
+ severed_relationships moderation_warning))
+ "") ;; mentions are normal statuses
+ (group
+ (mastodon-notifications--byline-accounts accounts group))
+ (t (mastodon-tl--byline-handle note nil
+ follower-name
+ 'mastodon-display-name-face)))))
+ (propertize
+ (concat action-symbol " " action-authors action-str)
+ 'byline-top t)))
+
+(defun mastodon-notifications--byline-action-str (message)
+ "Return an action (top) byline string for TOOT with MESSAGE."
+ (let ((resp (mastodon-notifications--response-alist-get message)))
+ (concat " "
+ (propertize message 'face 'mastodon-boosted-face)
+ " " resp "\n")))
+
+(defun mastodon-notifications--alist-by-value (str field json)
+ "From JSON, return the alist whose FIELD value matches STR.
+JSON is a list of alists."
+ (cl-some (lambda (y)
+ (when (string= str (alist-get field y))
+ y))
+ json))
+
+(defun mastodon-notifications--group-accounts (ids json)
+ "For IDS, return account data in JSON."
+ (cl-loop
+ for x in ids
+ collect (mastodon-notifications--alist-by-value x 'id json)))
+
+(defun mastodon-notifications--byline-accounts
+ (accounts group &optional avatar)
+ "Propertize author byline ACCOUNTS.
+GROUP is the group notification data.
+When AVATAR, include the account's avatar image."
+ (let ((total (alist-get 'notifications_count group))
+ (accts mastodon-notifications-grouped-names-count))
+ (concat
+ (string-trim ;; remove trailing newline
+ (cl-loop
+ for account in accounts
+ repeat accts
+ concat
+ (let-alist account
+ (concat
+ ;; avatar insertion moved up to `mastodon-tl--byline' by
+ ;; default to be outside 'byline propt.
+ (when (and avatar ; used by `mastodon-profile--format-user'
+ mastodon-tl--show-avatars
+ mastodon-tl--display-media-p
+ (mastodon-tl--image-trans-check))
+ (mastodon-media--get-avatar-rendering .avatar))
+ (let ((uname (mastodon-tl--display-or-uname account)))
+ (mastodon-tl--byline-handle account nil
+ uname 'mastodon-display-name-face))
+ ", ")))
+ nil ", ")
+ (if (< accts total)
+ (let ((diff (- total accts)))
+ (propertize ;; help-echo remaining notifs authors:
+ (format " and %s other%s" diff (if (= 1 diff) "" "s"))
+ 'help-echo (mapconcat (lambda (a)
+ (propertize (alist-get 'username a)
+ 'face 'mastodon-display-name-face))
+ (cddr accounts) ;; not first two
+ ", ")))))))
+
+;;; LOAD TIMELINE
+
+(defun mastodon-notifications--render (json no-group)
+ "Display grouped notifications in JSON.
+NO-GROUP means don't render grouped notifications."
+ ;; (setq masto-grouped-notifs json)
+ (let ((start-pos (point)))
+ (if no-group
+ (cl-loop for x in json
+ do (mastodon-notifications--format-note x))
+ (cl-loop
+ for g in (alist-get 'notification_groups json)
+ for accounts = (mastodon-notifications--group-accounts
+ (alist-get 'sample_account_ids g)
+ (alist-get 'accounts json))
+ for type = (alist-get 'type g)
+ for status = (mastodon-notifications--status-or-event g type json)
+ do (mastodon-notifications--format-group-note g status accounts)))
+ (when mastodon-tl--display-media-p
+ ;; images-in-notifs custom is handeld in
+ ;; `mastodon-tl--media-attachment', not here
+ (mastodon-media--inline-images start-pos (point)))))
+
+(defun mastodon-notifications--status-or-event (group type json)
+ "Return a notification's status or event data.
+Using GROUP data, notification TYPE, and overall notifs JSON."
+ (if (member type (map-keys mastodon-notifications--no-status-notif-alist))
+ ;; notifs w no status data:
+ (let ((key (alist-get type mastodon-notifications--no-status-notif-alist
+ nil nil #'equal)))
+ (alist-get key group))
+ (mastodon-notifications--alist-by-value
+ (alist-get 'status_id group)
+ 'id
+ (alist-get 'statuses json))))
+
+(defun mastodon-notifications--empty-group-json-p (json)
+ "Non-nil if JSON is empty grouped notifs data."
+ (equal json '((accounts) (statuses) (notification_groups))))
+
+(defun mastodon-notifications--timeline (json &optional type update)
+ "Format JSON in Emacs buffer.
+Optionally specify TYPE.
+UPDATE means we are updating, so skip some things."
+ (if (seq-empty-p json)
+ (user-error "Looks like you have no (more) notifications for now")
+ (unless update
+ (mastodon-widget--create
+ "Filter" mastodon-notifications--types
+ (or type "all")
+ (lambda (widget &rest _ignore)
+ (let ((value (widget-value widget)))
+ (mastodon-notifications-get-type value)))
+ :newline)
+ (insert "\n"))
+ ;; filtered/requests message:
+ (when (mastodon-notifications--notif-requests)
+ (insert
+ (substitute-command-keys
+ "You have filtered notifications. \
+\\[mastodon-notifications-requests] to view requests.\n\n")))
+ ;; set update point:
+ (setq mastodon-tl--update-point (point))
+ ;; render:
+ (setq mastodon-tl--update-point (point))
+ (mastodon-notifications--render json
+ (not mastodon-group-notifications))
+ (goto-char (point-min))
+ ;; set last read notif ID:
+ (save-excursion
+ (mastodon-tl-goto-next-item :no-refresh)
+ (let ((id (mastodon-tl--property 'item-id))) ;; notif not base
+ (mastodon-notifications--set-last-read id)))
+ (unless update ;; already in tl--update
+ (mastodon-tl-goto-next-item))))
+
+;;; VIEW LOADING FUNCTIONS
+
+(defun mastodon-notifications-get-type (&optional type)
+ "Read a notification type and load its timeline.
+Optionally specify TYPE."
+ (interactive)
+ (let ((choice (or type
+ (completing-read
+ "View notifications: "
+ mastodon-notifications--filter-types-alist))))
+ (funcall (alist-get
+ choice mastodon-notifications--filter-types-alist
+ nil nil #'equal))))
+
+(defun mastodon-notifications-cycle-type (&optional prefix)
+ "Cycle the current notifications view.
+With arg PREFIX, `completing-read' a type and load it."
+ (interactive "P")
+ ;; FIXME: do we need a sept buffer-type result for all notifs views?
+ (if (not (or (mastodon-tl--buffer-type-eq 'notifications)
+ (mastodon-tl--buffer-type-eq 'mentions)))
+ (user-error "Not in a notifications view")
+ (let* ((choice
+ (if prefix
+ (completing-read "Notifs by type: "
+ mastodon-notifications--types)
+ (mastodon-notifications--get-next-type)))
+ (fun (alist-get choice mastodon-notifications--filter-types-alist
+ nil nil #'equal)))
+ (funcall fun))))
+
+(defun mastodon-notifications--current-type ()
+ "Return the current notification type or nil."
+ (let* ((update-params (mastodon-tl--buffer-property
+ 'update-params nil :no-error)))
+ (alist-get "types[]" update-params nil nil #'equal)))
+
+(defun mastodon-notifications--get-next-type ()
+ "Return the next notif type based on current buffer spec."
+ (let* ((type (mastodon-notifications--current-type)))
+ (if (not type)
+ (cadr mastodon-notifications--types)
+ (or (cadr (member type mastodon-notifications--types))
+ (car mastodon-notifications--types)))))
+
+(defun mastodon-notifications-get-mentions ()
+ "Display mention notifications in buffer."
+ (interactive)
+ (mastodon-notifications-get "mention" "mentions"))
+
+(defun mastodon-notifications-get-favourites ()
+ "Display favourite notifications in buffer."
+ (interactive)
+ (mastodon-notifications-get "favourite" "favourites"))
+
+(defun mastodon-notifications-get-boosts ()
+ "Display boost notifications in buffer."
+ (interactive)
+ (mastodon-notifications-get "reblog" "boosts"))
+
+(defun mastodon-notifications-get-polls ()
+ "Display poll notifications in buffer."
+ (interactive)
+ (mastodon-notifications-get "poll" "polls"))
+
+(defun mastodon-notifications-get-statuses ()
+ "Display status notifications in buffer.
+Status notifications are created when you call
+`mastodon-tl-enable-notify-user-posts'."
+ (interactive)
+ (mastodon-notifications-get "status" "statuses"))
+
+(defun mastodon-notifications-get-follows ()
+ "Display follow notifications in buffer."
+ (interactive)
+ (mastodon-notifications-get "follow" "follows"))
+
+(defun mastodon-notifications-get-follow-requests ()
+ "Display follow request notifications in buffer."
+ (interactive)
+ (mastodon-notifications-get "follow_request" "follow-requests"))
+
+(defun mastodon-notifications-get-edits ()
+ "Display edited post notifications in buffer."
+ (interactive)
+ (mastodon-notifications-get "update" "edits"))
+
+(defun mastodon-notifications--filter-types-list (type)
+ "Return a list of notification types with TYPE removed."
+ (remove type mastodon-notifications--types))
+
+;;; CLEAR/DISMISS NOTIFS
+
+(defun mastodon-notifications-clear-all ()
+ "Clear all notifications."
+ (interactive)
+ (when (y-or-n-p "Clear all notifications?")
+ (let ((response
+ (mastodon-http--post
+ (mastodon-notifications--api "notifications/clear"))))
+ (mastodon-http--triage
+ response (lambda (_)
+ (when mastodon-tl--buffer-spec
+ (mastodon-tl--reload-timeline-or-profile))
+ (message "All notifications cleared!"))))))
+
+(defun mastodon-notifications-clear-current ()
+ "Dismiss the notification at point."
+ (interactive)
+ (let* ((id (or ;; grouping enabled
+ ;; (*should* also work for ungrouped items):
+ (mastodon-tl--property 'notification-id)
+ ;; FIXME: are these all required?
+ (mastodon-tl--property 'item-id)
+ (mastodon-tl--field
+ 'id
+ (mastodon-tl--property 'item-json))))
+ (endpoint (mastodon-notifications--api
+ (format "notifications/%s/dismiss" id)))
+ (response (mastodon-http--post endpoint)))
+ (mastodon-http--triage
+ response (lambda (_)
+ (when mastodon-tl--buffer-spec
+ (mastodon-tl--reload-timeline-or-profile))
+ (message "Notification dismissed!")))))
+
+;;; MISC
+
+(defun mastodon-notifications--set-last-read (id)
+ "Set the last read notification ID on the server."
+ (let ((endpoint (mastodon-http--api "markers"))
+ (params `(("notifications[last_read_id]" . ,id))))
+ (mastodon-http--post endpoint params)))
+
+(defun mastodon-notifications--get-last-read ()
+ "Return the last read notification ID from the server."
+ (let* ((params '(("timeline[]" . "notifications")))
+ (endpoint (mastodon-http--api "markers"))
+ (resp (mastodon-http--get-json endpoint params)))
+ (map-nested-elt resp '(notifications last_read_id))))
+
+(defun mastodon-notifications--get-single-notif ()
+ "Return a single notification JSON for v2 notifs."
+ (interactive)
+ (let* ((id ;; grouped (should work for ungrouped items):
+ (mastodon-tl--property 'notification-id))
+ (endpoint (mastodon-notifications--api
+ (format "notifications/%s" id)))
+ (response (mastodon-http--get-json endpoint)))
+ (message "%s" (prin1-to-string response))))
+
+(defun mastodon-notifications--get-unread-count ()
+ "Return the number of unread notifications for the current account."
+ ;; params: limit - max 1000, default 100, types[], exclude_types[], account_id
+ (let* ((endpoint "notifications/unread_count")
+ (url (mastodon-http--api endpoint
+ (when mastodon-group-notifications "v2")))
+ ;; NB: sync request!:
+ (resp (mastodon-http--get-json url nil :silent)))
+ (alist-get 'count resp)))
+
+(when (and mastodon-notifications-alerts
+ (require 'alert nil :noerror))
+ (alert-add-rule :mode 'mastodon-mode
+ :status '(buried visible idle selected)
+ :persistent
+ #'(lambda (info)
+ ;; If the buffer is buried, or the user has been idle
+ ;; for `alert-reveal-idle-time' seconds, make this
+ ;; alert persistent. Normally, alerts become
+ ;; persistent after `alert-persist-idle-time' seconds.
+ (memq (plist-get info :status) '(buried idle)))
+ ;; FIXME: if user configures this variable, we need to
+ ;; remove this rule and re-add it! or they need to restart
+ ;; emacs?:
+ :style mastodon-notifications-alert-style
+ :continue t))
+
+;;; REVOKE QUOTED STATUS
+;; POST /api/v1/statuses/:id/quotes/:quoting_status_id/revoke.
+(defun mastodon-notifications-revoke-post-quote ()
+ "Revoke the quote of a post from a quote notification."
+ (interactive)
+ ;; SCOPE required: check quote notif type, which will have user post in
+ ;; the "status" attribute:
+ (let* ((notif (mastodon-tl--property 'item-json :no-move))
+ (id (map-nested-elt notif '(quote quoted_status id)))
+ (quote-id (alist-get 'id notif))
+ (url (mastodon-http--api (format "statuses/%s/quotes/%s/revoke"
+ id quote-id))))
+ (when (y-or-n-p "Revoke quote of post at point?")
+ (let ((resp (mastodon-http--post url)))
+ (mastodon-http--triage
+ resp
+ (lambda (_resp)
+ (message "Quote of post revoked!")))))))
+
+;;; NOTIFICATION REQUESTS / FILTERING / POLICY
+
+(defvar mastodon-notifications--requests-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map mastodon-mode-map)
+ (define-key map (kbd "j") #'mastodon-notifications-request-reject)
+ (define-key map (kbd "a") #'mastodon-notifications-request-accept)
+ (define-key map (kbd "g") #'mastodon-notifications-requests)
+ map)
+ "Keymap for viewing follow requests.")
+
+;; FIXME: these are only for grouped notifs, else the fields are JSON bools
+(defvar mastodon-notifications-policy-vals
+ '("accept" "filter" "drop"))
+
+(defun mastodon-notifications-get-policy ()
+ "Return the notification filtering policy."
+ (let ((url (mastodon-notifications--api "notifications/policy")))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-notifications--notif-requests ()
+ "Non-nil if the user currently has pending/filtered notifications.
+Returns"
+ (let* ((policy (mastodon-notifications-get-policy))
+ (count (map-nested-elt policy '(summary pending_notifications_count))))
+ (if (and count (> count 0))
+ count)))
+
+(defun mastodon-notifications--pending-p ()
+ "Non-nil if there are any pending requests or notifications."
+ (let* ((json (mastodon-notifications-get-policy))
+ (summary (alist-get 'summary json)))
+ (or (not (= 0 (alist-get 'pending_requests_count summary)))
+ (not (= 0 (alist-get 'pending_notifications_count summary))))))
+
+(defun mastodon-notifications--update-policy (&optional params)
+ "Update notifications filtering policy.
+PARAMS is an alist of parameters."
+ ;; https://docs.joinmastodon.org/methods/notifications/#update-the-filtering-policy-for-notifications
+ (let ((url (mastodon-notifications--api "notifications/policy")))
+ (mastodon-http--patch url params)))
+
+(defun mastodon-notifications--get-requests (&optional params)
+ "Get a list of notification requests data from the server.
+PARAMS is an alist of parameters."
+ ;; NB: link header pagination
+ (let ((url (mastodon-notifications--api "notifications/requests")))
+ (mastodon-http--get-json url params)))
+
+(defun mastodon-notifications-request-accept (&optional reject)
+ "Accept a notification request for a user.
+This will merge any filtered notifications from them into the main
+notifications and accept any future notification from them.
+REJECT means reject notifications instead."
+ ;; POST /api/v1/notifications/requests/:id/accept
+ (interactive)
+ (let* ((id (mastodon-tl--property 'item-id))
+ (user (mastodon-tl--property 'notif-req-user))
+ (url (mastodon-http--api
+ (format "notifications/requests/%s/%s"
+ id (if reject "dismiss" "accept"))))
+ (resp (mastodon-http--post url)))
+ (mastodon-http--triage
+ resp
+ (lambda (_resp)
+ (message "%s notifications from %s"
+ (if reject "Not accepting" "Accepting") user)
+ ;; reload view:
+ (mastodon-notifications-requests)))))
+
+(defun mastodon-notifications-request-reject ()
+ "Reject a notification request for a user.
+Rejecting a request means any notifications from them will continue to
+be filtered."
+ (interactive)
+ (mastodon-notifications-request-accept :reject))
+
+(defun mastodon-notifications-requests ()
+ "Open a new buffer displaying the user's notification requests."
+ ;; calqued off `mastodon-views-view-follow-requests'
+ (interactive)
+ (mastodon-tl--init-sync
+ "notification-requests"
+ "notifications/requests"
+ 'mastodon-views--insert-notification-requests
+ nil
+ '(("limit" . "40")) ; server max is 80
+ :headers
+ "notification requests"
+ "a/j - accept/reject request at point\n\
+ n/p - go to next/prev request\n\
+ \\[mastodon-notifications-policy] - set filtering policy")
+ (mastodon-tl--goto-first-item)
+ (with-current-buffer "*mastodon-notification-requests*"
+ (use-local-map mastodon-notifications--requests-map)))
+
+(defun mastodon-views--insert-notification-requests (json)
+ "Insert the user's current notification requests.
+JSON is the data returned by the server."
+ (mastodon-views--minor-view
+ "notification requests"
+ #'mastodon-notifications--insert-users
+ json))
+;; masto-notif-req))
+
+(defun mastodon-notifications--insert-users (json)
+ "Insert users list into the buffer.
+JSON is the data from the server."
+ ;; calqued off `mastodon-views--insert-users-propertized-note'
+ ;; and `mastodon-search--insert-users-propertized'
+ (cl-loop for req in json
+ do (insert
+ (concat
+ (mastodon-notifications--format-req-user req)
+ mastodon-tl--horiz-bar "\n\n"))))
+
+(defun mastodon-notifications--format-req-user (req &optional note)
+ "Format a notification request user, REQ.
+NOTE means to include a profile note."
+ ;; calqued off `mastodon-search--propertize-user'
+ (let-alist req
+ (propertize
+ (concat
+ (propertize .account.username
+ 'face 'mastodon-display-name-face
+ 'byline t
+ 'notif-req-user .account.username
+ 'item-type 'notif-req
+ 'item-id .id) ;; notif req id
+ " : \n : "
+ (propertize (concat "@" .account.acct)
+ 'face 'mastodon-handle-face
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'user-handle
+ 'keymap mastodon-tl--link-keymap
+ 'mastodon-handle (concat "@" .account.acct)
+ 'help-echo (concat "Browse user profile of @" .account.acct))
+ " : \n"
+ (when note
+ (mastodon-tl--render-text .account.note .account))
+ "\n")
+ 'item-json req)))
+
+\f
+;;; UPDATES TIMER
+
+(defvar mastodon-notifications-notify-shown)
+
+(defvar mastodon-notifications-timer nil
+ "Timer to update the notifs buffer.")
+
+(defun mastodon-notifications-cancel-timer ()
+ "Cancel `mastodon-notifications-timer'.
+Also nil the variable."
+ (when (timerp mastodon-notifications-timer)
+ (cancel-timer mastodon-notifications-timer))
+ (setq mastodon-notifications-timer nil))
+
+(defun mastodon-notifications-notify (&optional count force)
+ "Send a desktop notification when we have COUNT unread notifications.
+If COUNT is nil, fetch again from server (synchronously).
+Uses `alert.el'.
+When FORCE, skip all checks and show an alert (for debugging)."
+ (let ((count (or count (mastodon-notifications--get-unread-count))))
+ (when (or force
+ (and (> count 0)
+ (not mastodon-notifications-notify-shown)))
+ (if (not (require 'alert nil :noerror))
+ (message "mastodon.el: new notifications %s" count)
+ (alert (format "New notifications: <b>%s</b>" count)
+ :title "mastodon.el"
+ ;; adding an alert.el rule as per above doesn't always work
+ ;; if a non-mastodon.el buffer is active (despite the 'buried
+ ;; status setting), so let's just give it a masto buffer:
+ :buffer (car (mastodon-live-buffers))))
+ (unless force
+ ;; we nil this in `mastodon-notifications-get':
+ (setq mastodon-notifications-notify-shown t)))))
+
+(defun mastodon-notifications--update-with-timer ()
+ "Run a timer to update notifications. Added to `mastodon-mode-hook'."
+ (cond
+ ;; if no buffers: cancel our timer and do nothing else:
+ ((and (not (mastodon-live-buffers))
+ ;; if we are loading a first mastodon.el buffer, the previous
+ ;; check fails, as `mastodon-mode-hook' necessariliy runs
+ ;; before we have buf-spec, which
+ ;; `mastodon-tl--get-buffer-type' relies on, and if we set
+ ;; buf-spec earlier, enabling the mode wipes it. So
+ ;; let's also check if the current buffer prefix is *mastodon-,
+ ;; which it will be when first calling `mastodon' at least
+ ;; (though not necessarily when loading other first mastodon.el
+ ;; buffers, such as new toot):
+ (not (string-prefix-p "*mastodon-" (buffer-name))))
+ ;; if not masto buffers: cancel everything:
+ (mastodon-notifications-cancel-timer))
+ ;; if a timer has already run but somehow
+ ;; `mastodon-notifications-timer' has not been nilled, assume it is a
+ ;; leftover and cancel it, otherwise our unless check below will always
+ ;; fail and no new timer will be created.
+ ;; NB: this gets called:
+ ;; - on creating a new mastodon.el buffer,
+ ;; - if an existing timer is run.
+ ;; in both cases, `timerp' should fail, but sometimes we have a
+ ;; zombie one somehow:
+ ((and (timerp mastodon-notifications-timer)
+ (timer--triggered mastodon-notifications-timer))
+ (mastodon-notifications-cancel-timer))
+ ;; maybe we can remove this unless check, and just always cancel and
+ ;; restart? that would have the effect of making the timer always
+ ;; run `mastodon-notifications-alerts-interval' seconds after opening
+ ;; a new mastodon.el buffer, or effectively only showing an alert if
+ ;; the user stops opening buffers:
+ (t
+ (unless mastodon-notifications-timer
+ ;; set new timer if we don't have one:
+ (setq mastodon-notifications-timer
+ (run-at-time mastodon-notifications-alerts-interval
+ nil #'mastodon-notifications--update-check))))))
+
+(defun mastodon-notifications--update-check ()
+ "Get unread notifications count from the server, asynchronously.
+Called by `mastodon-notifications--update-with-timer'.
+Callback is `mastodon-notifications--update-check-cb'."
+ (let* ((endpoint "notifications/unread_count")
+ (url (mastodon-http--api endpoint
+ (when mastodon-group-notifications "v2"))))
+ (mastodon-http--get-json-async
+ url nil :silent #'mastodon-notifications--update-check-cb)))
+
+(defun mastodon-notifications--update-check-cb (resp)
+ "Callback functions for handling unread notifs count response RESP."
+ (let ((count (alist-get 'count resp)))
+ (when (> count 0)
+ ;; (message "%s" (current-buffer)) ;; => *mastodon-home* / *messages*
+
+ ;; FIXME: unsure how to check if notifications buffer is active
+ ;; here, as (current-buffer) returns different things if this is
+ ;; triggered with notifs buffer active! so let's skip it for now,
+ ;; and only ever notify, not update the notifs buffer.
+
+ ;; (if ;;(not (mastodon-tl--buffer-type-eq 'notifications))
+ ;; (not mastodon-notifications-update-when-unread)
+ (mastodon-notifications-notify count)
+ ;; run updates if in notifs buffer:
+ ;; (message "Updating mastodon.el notifications...")
+ ;; (undo-boundary)
+ ;; (mastodon-tl-update)
+ ;; (undo-boundary)
+ ;; (message "Updating mastodon.el notifications... Done.")))
+ ;; cancel and set new timer:
+ (mastodon-notifications-cancel-timer)
+ (mastodon-notifications--update-with-timer))))
+
+(provide 'mastodon-notifications)
+;;; mastodon-notifications.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "mastodon" "20260406.856"
+ "Client for fediverse services using the Mastodon API."
+ '((emacs "29.1")
+ (persist "0.8")
+ (tp "0.8"))
+ :url "https://codeberg.org/martianh/mastodon.el"
+ :commit "5bba23045efda9f63c36ac431bec8f318a55e76a"
+ :revdesc "5bba23045efd"
+ :authors '(("Johnson Denen" . "johnson.denenNOSPAMgmail.com")
+ ("Marty Hiatt" . "mousebotNOSPAMdisroot.org"))
+ :maintainers '(("Marty Hiatt" . "mousebotNOSPAMdisroot.org")))
--- /dev/null
+;;; mastodon-profile.el --- Functions for inspecting Mastodon profiles -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-profile.el generates a stream of users toots.
+;; To add
+;; - Option to follow
+;; - wheather they follow you or not
+;; - Show only Media
+
+;;; Code:
+(require 'seq)
+(require 'cl-lib)
+(require 'persist)
+(require 'parse-time)
+(require 'mastodon-http)
+(eval-when-compile
+ (require 'mastodon-tl))
+(require 'mastodon-widget)
+(require 'table)
+
+(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-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-kill-window "mastodon")
+(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--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--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--toot "mastodon-tl")
+(autoload 'mastodon-tl--item-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")
+(autoload 'mastodon-return-credential-account "mastodon")
+(autoload 'mastodon-tl--buffer-property "mastodon-tl")
+(autoload 'mastodon-search-query "mastodon-search")
+(autoload 'mastodon-tl--field-status "mastodon-tl")
+(autoload 'mastodon-toot--with-toot-item "mastodon-toot" nil nil 'macro)
+(autoload 'mastodon-tl--toot-or-base "mastodon-tl")
+(autoload 'mastodon-views--end-of-table "mastodon-views")
+(autoload 'mastodon-tl--buttonify-link "mastodon-tl")
+(autoload 'mastodon-tl-read-handle-annotated "mastodon-tl")
+
+(defvar mastodon-active-user)
+(defvar mastodon-tl--horiz-bar)
+(defvar mastodon-tl--update-point)
+(defvar mastodon-toot--max-toot-chars)
+(defvar mastodon-toot--visibility)
+(defvar mastodon-toot--content-nsfw)
+(defvar mastodon-tl--timeline-posts-count)
+(defvar mastodon-group-notifications)
+
+(defvar-local mastodon-profile--account nil
+ "The data for the account being described in the current profile buffer.")
+
+(defvar mastodon-profile-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle)
+ (define-key map (kbd "C-c C-s") #'mastodon-profile-account-search)
+ (define-key map (kbd "C-c #") #'mastodon-profile-open-statuses-tagged)
+ map)
+ "Keymap for `mastodon-profile-mode'.")
+
+(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
+extra keybindings."
+ :init-value nil
+ :lighter " Profile"
+ :keymap mastodon-profile-mode-map
+ :group 'mastodon
+ :global nil)
+
+(defvar mastodon-profile-credential-account nil
+ "Holds the JSON data of the CredentialAccount entity.
+It contains details of the current user's account.")
+
+(defvar mastodon-profile-acccount-preferences-data nil
+ "Holds the JSON data of the current user's preferences.")
+
+(defvar mastodon-profile-update-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-c") #'mastodon-profile-user-profile-send-updated)
+ (define-key map (kbd "C-c C-k") #'mastodon-profile-update-profile-note-cancel)
+ map)
+ "Keymap for `mastodon-profile-update-mode'.")
+
+(persist-defvar mastodon-profile-account-settings nil
+ "An alist of account settings saved from the server.
+Other clients can change these settings on the server at any
+time, so this list is not the canonical source for settings. It
+is updated on entering mastodon mode and on toggle any setting it
+contains.
+This variable is set from data in
+`mastodon-profile-credential-account' not
+`mastodon-profile-account-preferences-data'.")
+
+(define-minor-mode mastodon-profile-update-mode
+ "Minor mode to update user profile."
+ :group 'mastodon-profile
+ :keymap mastodon-profile-update-mode-map
+ :global nil)
+
+(defun mastodon-profile--item-json ()
+ "Get the next item-json."
+ (mastodon-tl--property 'item-json))
+
+(defun mastodon-profile--make-author-buffer
+ (account &optional no-reblogs no-replies only-media tag max-id
+ skip-pinned)
+ "Take an ACCOUNT json and insert a user account into a new buffer.
+NO-REBLOGS means do not display boosts in statuses.
+NO-REPLIES means to exlude replies.
+ONLY-MEDIA means show only posts containing attachments.
+TAG is a hashtag to restrict posts to.
+MAX-ID is a flag to include the max_id pagination parameter.
+SKIP-PINNED means don't display pinned toots."
+ (mastodon-profile--make-profile-buffer-for
+ account "statuses" #'mastodon-tl--timeline no-reblogs nil
+ no-replies only-media tag max-id skip-pinned))
+
+;;; PROFILE VIEW COMMANDS
+
+(defvar mastodon-profile--account-view-alist
+ '((statuses . mastodon-profile-open-statuses)
+ (no-boosts . mastodon-profile-open-statuses-no-reblogs)
+ (no-replies . mastodon-profile-open-statuses-no-replies)
+ (only-media . mastodon-profile-open-statuses-only-media)
+ (followers . mastodon-profile-open-followers)
+ (following . mastodon-profile-open-following)
+ (tag . mastodon-profile-open-statuses-tagged)))
+
+(defun mastodon-profile--view-types ()
+ "Return the keys of `mastodon-profile--account-view-alist' as a list."
+ (map-keys mastodon-profile--account-view-alist))
+
+(defun mastodon-profile-account-view-cycle (&optional prefix)
+ "Cycle through profile view: toots, toot sans boosts, followers, and following.
+If a PREFIX argument is provided, prompt for a view type and load."
+ (interactive "P")
+ (if prefix
+ (let* ((choice
+ (completing-read "Profile view:"
+ mastodon-profile--account-view-alist))
+ (fun (alist-get choice mastodon-profile--account-view-alist)))
+ (funcall fun))
+ (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-statuses-no-replies))
+ ((mastodon-tl--buffer-type-eq 'profile-statuses-no-replies)
+ (mastodon-profile-open-statuses-only-media))
+ ((mastodon-tl--buffer-type-eq 'profile-statuses-only-media)
+ (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)))))
+
+(defun mastodon-profile-open-statuses ()
+ "Open a profile showing statuses."
+ (interactive)
+ (if mastodon-profile--account
+ (mastodon-profile--make-author-buffer
+ mastodon-profile--account)
+ (user-error "Not in a mastodon profile")))
+
+(defun mastodon-profile-open-statuses-no-replies ()
+ "Open a profile buffer showing statuses without replies."
+ (interactive)
+ (if mastodon-profile--account
+ (mastodon-profile--make-author-buffer
+ mastodon-profile--account nil :no-replies)
+ (user-error "Not in a mastodon profile")))
+
+(defun mastodon-profile-open-statuses-no-reblogs ()
+ "Open a profile buffer showing statuses without reblogs."
+ (interactive)
+ (if mastodon-profile--account
+ (mastodon-profile--make-author-buffer
+ mastodon-profile--account :no-reblogs)
+ (user-error "Not in a mastodon profile")))
+
+(defun mastodon-profile-open-statuses-only-media ()
+ "Open a profile buffer showing only statuses with media."
+ (interactive)
+ (if mastodon-profile--account
+ (mastodon-profile--make-author-buffer
+ mastodon-profile--account nil nil :only-media nil nil :skip-pinned)
+ (user-error "Not in a mastodon profile")))
+
+(defun mastodon-profile-open-statuses-tagged (&optional tag)
+ "Prompt for a TAG and display a profile with statuses containing it."
+ (interactive)
+ (let ((tag (or tag (read-string "Statuses containing tag: "))))
+ (if mastodon-profile--account
+ (mastodon-profile--make-author-buffer mastodon-profile--account nil nil nil tag nil :skip-pinned)
+ (user-error "Not in a mastodon profile"))))
+
+(defun mastodon-profile-open-following ()
+ "Open a profile buffer showing the accounts that current profile follows."
+ (interactive)
+ (if mastodon-profile--account
+ (mastodon-profile--make-profile-buffer-for
+ mastodon-profile--account "following"
+ #'mastodon-profile--format-user nil :headers)
+ (user-error "Not in a mastodon profile")))
+
+(defun mastodon-profile-open-followers ()
+ "Open a profile buffer showing the accounts following the current profile."
+ (interactive)
+ (if mastodon-profile--account
+ (mastodon-profile--make-profile-buffer-for
+ mastodon-profile--account "followers"
+ #'mastodon-profile--format-user nil :headers)
+ (user-error "Not in a mastodon profile")))
+
+(defun mastodon-profile-view-favourites ()
+ "Open a new buffer displaying the user's favourites."
+ (interactive)
+ (message "Loading your favourited toots...")
+ (mastodon-tl--init "favourites" "favourites"
+ 'mastodon-tl--timeline :headers))
+
+(defun mastodon-profile-view-bookmarks ()
+ "Open a new buffer displaying the user's bookmarks."
+ (interactive)
+ (message "Loading your bookmarked toots...")
+ (mastodon-tl--init "bookmarks" "bookmarks"
+ 'mastodon-tl--timeline :headers))
+
+(defun mastodon-profile-add-account-to-list ()
+ "Add account of current profile buffer to a list."
+ (interactive)
+ (if (not mastodon-profile--account)
+ (user-error "No profile to add?")
+ (let-alist mastodon-profile--account
+ (mastodon-views-add-account-to-list nil .id .acct))))
+
+(defun mastodon-profile-account-search (query)
+ "Run a statuses search QUERY for the currently viewed account."
+ (interactive "sSearch account for: ")
+ (let* ((ep (mastodon-tl--buffer-property 'endpoint))
+ (id (nth 1 (split-string ep "/"))))
+ (mastodon-search-query query "statuses" nil nil id)))
+
+\f
+;;; ACCOUNT PREFERENCES
+
+(defun mastodon-profile--get-account-value (key function)
+ "Fetch KEY from data returned by FUNCTION.
+If value is :json-false, return nil."
+ (let* ((response (funcall function))
+ (value (alist-get key response)))
+ (if (eq value :json-false) nil value)))
+
+(defun mastodon-profile--get-json-value (key)
+ "Fetch value for KEY from account.
+Account details are from `mastodon-return-credential-account'.
+If value is :json-false, return nil."
+ (mastodon-profile--get-account-value
+ key #'mastodon-return-credential-account))
+
+(defun mastodon-profile--get-source-values ()
+ "Return the \"source\" preferences from the server."
+ (mastodon-profile--get-json-value 'source))
+
+(defun mastodon-profile--get-source-value (pref)
+ "Return PREF erence from the account's \"source\" field."
+ (mastodon-profile--get-account-value
+ pref #'mastodon-profile--get-source-values))
+
+(defun mastodon-profile-update-user-profile-note ()
+ "Fetch user's profile note and display for editing."
+ (interactive)
+ (let* ((source (mastodon-profile--get-source-values))
+ (note (alist-get 'note source))
+ (buffer (get-buffer-create "*mastodon-update-profile*"))
+ (inhibit-read-only t)
+ (msg-str
+ (substitute-command-keys
+ "Edit your profile note. \\`C-c C-c' to send, \\`C-c C-k' to cancel.")))
+ (switch-to-buffer-other-window buffer)
+ (text-mode)
+ (mastodon-tl--set-buffer-spec (buffer-name buffer)
+ "accounts/verify_credentials" nil)
+ (setq-local header-line-format msg-str)
+ (mastodon-profile-update-mode t)
+ (insert (propertize (concat
+ (propertize "0"
+ 'note-counter t
+ 'display nil)
+ "/500 characters")
+ 'read-only t
+ 'face 'mastodon-toot-docs-face
+ 'note-header t)
+ "\n")
+ (make-local-variable 'after-change-functions)
+ (cl-pushnew #'mastodon-profile--update-note-count after-change-functions)
+ (let ((start-point (point)))
+ (insert note)
+ (goto-char start-point))
+ (delete-trailing-whitespace) ; remove all ^M's
+ (message msg-str)))
+
+(defun mastodon-profile--update-note-count (&rest _args)
+ "Display the character count of the profile note buffer."
+ (let* ((inhibit-read-only t)
+ (header-region (mastodon-tl--find-property-range 'note-header
+ (point-min)))
+ (count-region (mastodon-tl--find-property-range 'note-counter
+ (point-min)))
+ (count (number-to-string (mastodon-toot--count-toot-chars
+ (buffer-substring-no-properties
+ (cdr header-region) (point-max))))))
+ (add-text-properties (car count-region) (cdr count-region)
+ (list 'display count))))
+
+(defun mastodon-profile-update-profile-note-cancel ()
+ "Cancel updating user profile and kill buffer and window."
+ (interactive)
+ (when (y-or-n-p "Cancel updating your profile note?")
+ (mastodon-kill-window)))
+
+(defun mastodon-profile--note-remove-header ()
+ "Get the profile note, without the buffer header."
+ (let ((header-region (mastodon-tl--find-property-range 'note-header
+ (point-min))))
+ (buffer-substring (cdr header-region) (point-max))))
+
+(defun mastodon-profile-user-profile-send-updated ()
+ "Send PATCH request with the updated profile note.
+Ask for confirmation if length > 500 characters."
+ (interactive)
+ (let* ((note (mastodon-profile--note-remove-header))
+ (url (mastodon-http--api "accounts/update_credentials")))
+ (when (or (not (> (mastodon-toot--count-toot-chars note) 500))
+ (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?"))
+ (quit-window 'kill)
+ (mastodon-profile--user-profile-send-updated-do url note))))
+
+(defun mastodon-profile--user-profile-send-updated-do (url note)
+ "Send PATCH request with the updated profile NOTE to URL."
+ (let ((response (mastodon-http--patch url `(("note" . ,note)))))
+ (mastodon-http--triage response
+ (lambda (_) (message "Profile note updated!")))))
+
+(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."
+ (let* ((url (mastodon-http--api "accounts/update_credentials"))
+ (pref-formatted (if source (concat "source[" pref "]") pref))
+ (response (mastodon-http--patch url `((,pref-formatted . ,val)))))
+ (mastodon-http--triage response
+ (lambda (_)
+ (mastodon-profile--fetch-server-account-settings)
+ (message "Account setting %s updated to %s!" pref val)))))
+
+(defun mastodon-profile--get-pref (pref)
+ "Return PREF from `mastodon-profile-account-settings'."
+ (plist-get mastodon-profile-account-settings pref))
+
+(defun mastodon-profile--update-preference-plist (pref val)
+ "Set local account preference plist preference PREF to VAL.
+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."
+ (mastodon-profile--fetch-server-account-settings :no-force))
+
+;; FIXME: this does one request per setting! should just do one request then
+;; parse
+(defun mastodon-profile--fetch-server-account-settings (&optional no-force)
+ "Fetch basic account settings from the server.
+Store the values in `mastodon-profile-account-settings'.
+Run in `mastodon-mode-hook'.
+If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil."
+ (unless (and no-force mastodon-profile-account-settings)
+ (let ((keys '(locked discoverable display_name bot))
+ (source-keys '(privacy sensitive language)))
+ (mapc (lambda (k)
+ (mastodon-profile--update-preference-plist
+ k (mastodon-profile--get-json-value k)))
+ keys)
+ (mapc (lambda (sk)
+ (mastodon-profile--update-preference-plist
+ sk (mastodon-profile--get-source-value sk)))
+ source-keys)
+ ;; hack for max toot chars:
+ (mastodon-toot--get-max-toot-chars :no-toot)
+ (mastodon-profile--update-preference-plist 'max_toot_chars
+ mastodon-toot--max-toot-chars)
+ ;; TODO: remove now redundant vars, replace with fetchers from the plist
+ (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy)
+ mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive))
+ mastodon-profile-account-settings)))
+
+(defun mastodon-profile-account-locked-toggle ()
+ "Toggle the locked status of your account.
+Locked means follow requests have to be approved."
+ (interactive)
+ (mastodon-profile--toggle-account-key 'locked))
+
+(defun mastodon-profile-account-discoverable-toggle ()
+ "Toggle the discoverable status of your account.
+Discoverable means the account is listed in the server directory."
+ (interactive)
+ (mastodon-profile--toggle-account-key 'discoverable))
+
+(defun mastodon-profile-account-bot-toggle ()
+ "Toggle the bot status of your account."
+ (interactive)
+ (mastodon-profile--toggle-account-key 'bot))
+
+(defun mastodon-profile-account-sensitive-toggle ()
+ "Toggle the sensitive status of your account.
+When enabled, statuses are marked as sensitive by default."
+ (interactive)
+ (mastodon-profile--toggle-account-key 'sensitive :source))
+
+(defun mastodon-profile--toggle-account-key (key &optional source)
+ "Toggle the boolean account setting KEY.
+SOURCE means the setting is located under \"source\" in the account JSON.
+Current settings are fetched from the server."
+ (let* ((val (if source
+ (mastodon-profile--get-source-value key)
+ (mastodon-profile--get-json-value key)))
+ (prompt (format "Account setting %s is %s. Toggle?" key val)))
+ (when (y-or-n-p prompt)
+ (mastodon-profile--update-preference (symbol-name key)
+ (if val "false" "true")
+ source))))
+
+(defun mastodon-profile--edit-string-value (key)
+ "Edit the string for account preference KEY."
+ (let* ((val (mastodon-profile--get-json-value key))
+ (new-val (read-string (format "Edit account setting %s: " key)
+ val)))
+ (mastodon-profile--update-preference (symbol-name key) new-val)))
+
+(defun mastodon-profile-update-display-name ()
+ "Update display name for your account."
+ (interactive)
+ (mastodon-profile--edit-string-value 'display_name))
+
+(defun mastodon-profile--make-meta-fields-params (fields)
+ "Construct a parameter query string from metadata alist FIELDS.
+Returns an alist."
+ (let ((keys
+ (cl-loop
+ for count from 1 to 5
+ collect (cons (format "fields_attributes[%s][name]" count)
+ (format "fields_attributes[%s][value]" count)))))
+ (cl-loop for a-pair in keys
+ for b-pair in fields
+ append (list (cons (car a-pair) (car b-pair))
+ (cons (cdr a-pair) (cdr b-pair))))))
+
+(defun mastodon-profile-update-meta-fields ()
+ "Prompt for new metadata fields information and PATCH the server."
+ (interactive)
+ (let* ((url (mastodon-http--api "accounts/update_credentials"))
+ (fields-updated (mastodon-profile--update-meta-fields-alist))
+ (params (mastodon-profile--make-meta-fields-params fields-updated))
+ (response (mastodon-http--patch url params)))
+ (mastodon-http--triage response
+ (lambda (_)
+ (mastodon-profile--fetch-server-account-settings)
+ (message "Metadata fields updated to %s!"
+ fields-updated)))))
+
+(defun mastodon-profile--update-meta-fields-alist ()
+ "Prompt for new metadata fields information.
+Returns the results as an alist."
+ (let ((fields-old (mastodon-profile--fields-get
+ nil ;; we must fetch the plaintext version:
+ (mastodon-profile--get-source-value 'fields))))
+ ;; offer empty fields if user currently has less than four filled:
+ (while (< (length fields-old) 4)
+ (setq fields-old (append fields-old '(("" . "")))))
+ (let* ((f-str "Metadata %s [%s/4] (max. 255 chars): ")
+ (alist
+ (cl-loop for f in fields-old
+ for x from 1 to 5
+ collect
+ (cons (read-string (format f-str "key" x) (car f))
+ (read-string (format f-str "value" x) (cdr f))))))
+ (mapcar (lambda (x)
+ (cons (mastodon-profile--limit-to-255 (car x))
+ (mastodon-profile--limit-to-255 (cdr x))))
+ alist))))
+
+(defun mastodon-profile--limit-to-255 (x)
+ "Limit string X to 255 chars max."
+ (if (> (length x) 255) (substring x 0 255) x))
+
+;; used in tl.el and toot.el:
+(defun mastodon-profile--get-preferences-pref (pref)
+ "Fetch PREF from the endpoint \"/preferences\".
+If `mastodon-profile-acccount-preferences-data' is set, fetch
+from that instead.
+The endpoint only holds a few preferences. For others, see
+`mastodon-profile--update-preference' and its endpoint,
+\"/accounts/update_credentials.\""
+ (alist-get pref
+ (or mastodon-profile-acccount-preferences-data
+ (setq mastodon-profile-acccount-preferences-data
+ (mastodon-http--get-json
+ (mastodon-http--api "preferences"))))))
+
+(defun mastodon-profile-view-preferences ()
+ "View user preferences in another window."
+ (interactive)
+ (let* ((url (mastodon-http--api "preferences"))
+ (response (mastodon-http--get-json url))
+ (buf (get-buffer-create "*mastodon-preferences*")))
+ (with-mastodon-buffer buf #'special-mode :other-window
+ (mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil)
+ (while-let ((el (pop response)))
+ (insert (format "%-30s %s"
+ (prin1-to-string (car el))
+ (prin1-to-string (cdr el)))
+ "\n\n"))
+ (goto-char (point-min)))))
+
+(defvar mastodon-profiles-quote-policy-types
+ '(public followers nobody))
+
+(defun mastodon-profile-set-quote-policy ()
+ "Prompt for a quote policy and set it in the user's preferences."
+ (interactive)
+ (let* ((prefs
+ ;; this fetches from a local var, we want to fetch from server,
+ ;; else we need this var to update when we change this setting:
+ ;; (mastodon-profile--get-source-values))
+ ;; so we fetch from preferences instead:
+ (mastodon-http--get-json (mastodon-http--api "preferences")))
+ (current (alist-get 'posting:default:quote_policy prefs))
+ (choice (completing-read
+ (format "Set default quote policy [current: %s]: " current)
+ mastodon-profiles-quote-policy-types nil :match)))
+ (mastodon-profile--update-preference "quote_policy" choice 'source)))
+
+\f
+;;; PROFILE VIEW DETAILS
+
+(defun mastodon-profile--relationships-get (id)
+ "Fetch info about logged-in user's relationship to user with id ID."
+ (let* ((args `(("id[]" . ,id)))
+ (url (mastodon-http--api "accounts/relationships")))
+ ;; FIXME: API takes array, we just get 1st
+ (car (mastodon-http--get-json url args))))
+
+(defun mastodon-profile--fields-get (&optional account fields)
+ "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT.
+Returns an alist.
+FIELDS means provide a fields vector fetched by other means."
+ (let ((fields (or fields (alist-get 'fields account))))
+ (when fields
+ (mastodon-tl--map-alist-vals-to-alist 'name 'value fields))))
+
+(defun mastodon-profile--format-fields (fields)
+ "Format field pairs (a.k.a profile metadata) in FIELDS."
+ ;; prevent `mastodon-tl--render-text' from adding any newlines:
+ (let* ((mastodon-tl--no-fill-on-render t)
+ ;; render sans variable pitch:
+ ;; (mastodon-tl--enable-proportional-fonts nil)
+ ;; to set cell witdth right, we have to render any html first:
+ (rendered (mapcar (lambda (x)
+ (cons
+ (mastodon-tl--render-text (car x) x)
+ (mastodon-tl--render-text (cdr x) x)))
+ fields))
+ (left-longest (apply #'max (mapcar #'length
+ (mapcar #'car rendered))))
+ (left-width (min 30 left-longest))
+ (right-longest (apply #'max (mapcar #'length
+ (mapcar #'cdr rendered))))
+ ;; some people have very long URLs in their entries, so we set a
+ ;; max of (- window-width left-width). that way, long cells will
+ ;; run over onto multiple lines when we enable
+ ;; `table-fixed-width-mode':
+ (right-width (min
+ (if (> (frame-width) left-width)
+ (- (frame-width) (+ 10 left-width))
+ ;; bizarre fallback:
+ (/ (frame-width) 3)) ;; 30)
+ right-longest)))
+ (mastodon-profile--pretty-table
+ #'mastodon-profile--insert-fields
+ `(,(+ 2 left-width) ,(+ 2 right-width)) rendered)))
+
+(defun mastodon-profile--pretty-table (insert-fun &optional min-cell-width
+ &rest insert-args)
+ "Insert some data and make a pretty table of it with table.el.
+Call INSERT-FUN with INSERT-ARGS.
+MIN-CELL-WIDTH is for `table-capture'.
+Note that it can be a list of values, one for each column."
+ (let* ((mastodon-tl--no-fill-on-render t)
+ (table-cell-horizontal-chars
+ (if (char-displayable-p ?–) "–" "-"))
+ (mastodon-tl--enable-proportional-fonts nil)
+ (beg (point)))
+ ;; remove crazy table-cell face:
+ (face-remap-add-relative 'table-cell 'default)
+ (apply insert-fun insert-args)
+ (table-capture beg (point) "|" "\n" nil min-cell-width)
+ ;; center our content by col:
+ (let* ((cols (nth 4 (table-query-dimension))))
+ (dotimes (_x cols)
+ (table-justify-column 'center)
+ (table-forward-cell)))
+ ;; (table-release) ;; removes frame, but fixes links
+ (mastodon-views--end-of-table)
+ (table-fixed-width-mode 1)
+ ;; unfuck `table-fixed-width-mode' disastrous face handling:
+ (set-face-attribute 'table-cell nil :inverse-video nil)
+ (add-text-properties beg (point) '(face 'success))))
+
+(defun mastodon-profile-table-cell-hook-fun ()
+ "Hook function for `table-cell-map-hook'.
+We ensure we have our tab/click/RET bindings active for links."
+ (define-key table-cell-map
+ [remap table-forward-cell] #'mastodon-tl-next-tab-item)
+ (define-key table-cell-map
+ [remap table-backward-cell] #'mastodon-tl-previous-tab-item)
+ (define-key table-cell-map
+ [remap *table--cell-newline] #'mastodon-tl-do-link-action-at-point)
+ (define-key table-cell-map [mouse-2] #'mastodon-tl-do-link-action)
+ (define-key table-cell-map [follow-link] 'mouse-face))
+
+(defun mastodon-profile--insert-fields (fields)
+ "Insert profile metadata FIELDS, an alist.
+Format them so we can create a pretty table."
+ (insert
+ (mapconcat
+ (lambda (field)
+ (concat
+ (mastodon-profile--sane-field-str (car field))
+ " | "
+ (mastodon-profile--sane-field-str (cdr field))))
+ fields "\n")))
+
+(defun mastodon-profile--sane-field-str (str)
+ "In STR, replace | with / and trim spaces/newlines.
+We replace | because it is our pretty table's column delimiter."
+ (string-trim
+ (replace-regexp-in-string "|" "/" str)
+ "[ \n]"))
+
+(defun mastodon-profile--get-statuses-pinned (account)
+ "Fetch the pinned toots for ACCOUNT."
+ (let* ((id (alist-get 'id account))
+ (args `(("pinned" . "true")))
+ (url (mastodon-http--api (format "accounts/%s/statuses" id))))
+ (mastodon-http--get-json url args)))
+
+(defun mastodon-profile--insert-statuses-pinned (pinned-statuses)
+ "Insert each of the PINNED-STATUSES for a given account."
+ (cl-loop for s in pinned-statuses
+ do (progn
+ (insert
+ (concat "\n "
+ (propertize " pinned "
+ 'face '(:inherit success :box t))
+ " "))
+ (mastodon-tl--toot s))))
+
+(defun mastodon-profile--follows-p (list)
+ "T if you have any relationship with the accounts in LIST."
+ (let (result)
+ (dolist (x list result)
+ (when (not (eq :json-false x))
+ (setq result x)))))
+
+(defun mastodon-profile--render-roles (roles)
+ "Return a propertized string of badges for ROLES."
+ (mapconcat
+ (lambda (role)
+ (propertize (alist-get 'name role)
+ 'face `(:box t :foreground ,(alist-get 'color role))))
+ roles))
+
+(defun mastodon-profile--render-moved (data)
+ "Return a propertized string of a migrated account link.
+DATA is an account data from a moved field in profile data."
+ (let-alist data
+ (let ((handle (concat "@" .acct)))
+ (concat
+ "this account has migrated to: "
+ (mastodon-tl--buttonify-link
+ handle
+ 'face 'shr-link ;'mastodon-handle-face
+ 'mastodon-tab-stop 'user-handle
+ 'shr-url .url
+ 'mastodon-handle handle
+ 'help-echo (concat "Browse user profile of " handle))
+ "\n\n"))))
+
+(defun mastodon-profile--insert-counts (toots followers following)
+ "Insert counts as a pretty table.
+TOOTS FOLLOWERS and FOLLOWING are each integers."
+ (let ((table-cell-horizontal-chars (if (char-displayable-p ?–)
+ "–"
+ "-"))
+ (toot-cell (concat " TOOTS: " (mastodon-tl--as-string toots)))
+ (followers-cell (concat "FOLLOWERS: "
+ (mastodon-tl--as-string followers)))
+ (following-cell (concat "FOLLOWING: "
+ (mastodon-tl--as-string following))))
+ (mastodon-profile--pretty-table
+ (lambda ()
+ (insert
+ (concat toot-cell " | " followers-cell " | " following-cell
+ "\n")))
+ `(,(+ 2 (length toot-cell)) ,(+ 2 (length followers-cell))
+ ,(+ 2 (length following-cell))))))
+
+(defun mastodon-profile--insert-joined (joined)
+ "Insert JOINED data as a pretty table."
+ (let ((join-str "Joined: ")
+ (date-str (mastodon-profile--format-joined-date-string joined)))
+ (mastodon-profile--pretty-table
+ (lambda () (insert join-str "|" date-str))
+ `(,(+ 2 (length join-str)) ,(+ 2 (length date-str))))))
+
+(defun mastodon-profile--insert-relationships (relationships)
+ "Insert RELATIONSHIPS data."
+ (let-alist relationships
+ ;; (sharkey has no relationships endpoint, returns 500.
+ ;; or poss it has a different endpoint?:)
+ (when .id
+ (let* ((followsp
+ (mastodon-profile--follows-p
+ (list .requested_by .following .followed_by .blocked_by)))
+ (rels (mastodon-profile--relationships-get .id))
+ (langs-filtered (when-let* ((langs (alist-get 'languages rels)))
+ (concat " ("
+ (mapconcat #'identity langs " ")
+ ")")))
+ (fold-str (concat "FOLLOWED BY YOU |" langs-filtered))
+ (fols-str "FOLLOWS YOU |")
+ (req-str "REQUESTED TO FOLLOW YOU |")
+ (block-str "BLOCKS YOU |")
+ (str-list (cl-remove
+ nil (list (when (eq .following t) fold-str)
+ (when (eq .followed_by t) fols-str)
+ (when (eq .requested_by t) req-str)
+ (when (eq .blocked_by t) block-str)))))
+ (when followsp
+ (mastodon-profile--pretty-table
+ (lambda ()
+ (insert
+ (apply #'concat str-list)))
+ (cl-loop for x in str-list
+ collect (+ 2 (length x)))))))))
+
+(defun mastodon-profile--make-profile-buffer-for
+ (account endpoint-type update-function
+ &optional no-reblogs headers no-replies only-media tag max-id
+ skip-pinned)
+ "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION.
+NO-REBLOGS means do not display boosts in statuses.
+HEADERS means also fetch link headers for pagination.
+NO-REPLIES means to exlude replies.
+ONLY-MEDIA means show only posts containing attachments.
+TAG is a hashtag to restrict posts to.
+MAX-ID is a flag to include the max_id pagination parameter.
+SKIP-PINNED means don't display pinned toots."
+ (let-alist account
+ (let* ((max-id-str (when max-id
+ (mastodon-tl--buffer-property 'max-id)))
+ (args `(("limit" . ,mastodon-tl--timeline-posts-count)
+ ,(when max-id `("max_id" . ,max-id-str))))
+ (args (cond (no-reblogs
+ (push '("exclude_reblogs" . "t") args))
+ (no-replies
+ (push '("exclude_replies" . "t") args))
+ (only-media
+ (push '("only_media" . "t") args))
+ (tag
+ (push `("tagged" . ,tag) args))
+ (t args)))
+ (endpoint (format "accounts/%s/%s" .id endpoint-type))
+ (url (mastodon-http--api endpoint))
+ (buffer (concat "*mastodon-" .acct "-"
+ (concat endpoint-type
+ (cond (no-reblogs "-no-boosts")
+ (no-replies "-no-replies")
+ (only-media "-only-media")
+ (tag (format "-tagged-%s" tag))
+ (t "")))
+ "*"))
+ (response (if headers
+ (mastodon-http--get-response url args)
+ (mastodon-http--get-json url args)))
+ (json (if headers (car response) response))
+ (link-header (when headers
+ (mastodon-tl--get-link-header-from-response
+ (cdr response))))
+ (fields (mastodon-profile--fields-get account))
+ (pinned (mastodon-profile--get-statuses-pinned account))
+ (relationships (mastodon-profile--relationships-get .id)))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-profile-mode)
+ (setq mastodon-profile--account account)
+ (mastodon-tl--set-buffer-spec buffer endpoint update-function
+ link-header args nil max-id-str)
+ (let* ((inhibit-read-only t))
+ (insert
+ (propertize
+ (concat
+ "\n"
+ (mastodon-profile--image-from-account account 'avatar_static)
+ (mastodon-profile--image-from-account account 'header_static)
+ "\n"
+ (when .display_name
+ (propertize (if (string-empty-p .display_name)
+ .username
+ .display_name)
+ 'face 'mastodon-display-name-face))
+ ;; roles
+ (when .roles
+ (concat " " (mastodon-profile--render-roles .roles)))
+ "\n"
+ (propertize (concat "@" .acct) 'face 'default)
+ (when (eq .locked t)
+ (concat " " (mastodon-tl--symbol 'locked)))
+ "\n " mastodon-tl--horiz-bar "\n"
+ ;; migration:
+ (when .moved
+ (mastodon-profile--render-moved .moved))
+ ;; profile note:
+ (mastodon-tl--render-text .note account) ; account = tab-stops in profile
+ "\n")
+ 'profile-json account))
+ ;; Joined date:
+ (mastodon-profile--insert-joined .created_at)
+ ;; meta fields:
+ (when fields
+ (mastodon-profile--format-fields fields))
+ ;; insert counts
+ (mastodon-profile--insert-counts .statuses_count
+ .followers_count .following_count)
+ ;; insert relationship (follows)
+ (mastodon-profile--insert-relationships relationships)
+ (mastodon-media--inline-images (point-min) (point))
+ ;; widget items description
+ (mastodon-widget--create
+ "View" (mastodon-profile--view-types)
+ (or (mastodon-profile--current-view-type
+ endpoint-type no-reblogs no-replies only-media tag)
+ 'statuses)
+ (lambda (widget &rest _ignore)
+ (let ((value (widget-value widget)))
+ (funcall
+ (alist-get value
+ mastodon-profile--account-view-alist)))))
+ (insert "\n")
+ (setq mastodon-tl--update-point (point))))
+ ;; split insert of items from insert of profile:
+ (with-current-buffer buffer
+ (let* ((inhibit-read-only t))
+ ;; insert pinned toots first
+ (when (and (not skip-pinned)
+ pinned
+ (string= endpoint-type "statuses"))
+ (let ((beg (point)))
+ (mastodon-profile--insert-statuses-pinned pinned)
+ (setq mastodon-tl--update-point (point))
+ (mastodon-media--inline-images beg (point)))) ; updates after pinned toots
+ ;; insert items
+ (funcall update-function json)
+ (goto-char (point-min))
+ (message
+ (substitute-command-keys
+ ;; "\\[mastodon-profile-account-view-cycle]" ; not always bound?
+ "\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\
+ only media, followers, following.
+\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag.")))))))
+
+(defun mastodon-profile--current-view-type (type no-reblogs no-replies
+ only-media tag)
+ "Return the type of current profile view.
+Return a member of `mastodon-profile--view-types', based on TYPE,
+NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG."
+ (cond (no-reblogs 'no-boosts)
+ (no-replies 'no-replies)
+ (only-media 'only-media)
+ (tag 'tag)
+ (t (if (stringp type) (intern type) type))))
+
+(defun mastodon-profile--format-joined-date-string (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 "%d %B %Y"
+ (parse-iso8601-time-string joined)))
+
+(defun mastodon-profile-get-toot-author (&optional max-id)
+ "Open profile of author of toot under point.
+If toot is a boost, load the profile of the author of the original item.
+MAX-ID is a flag to include the max_id pagination parameter."
+ (interactive)
+ (mastodon-tl--do-if-item
+ (let ((json (mastodon-tl--toot-or-base
+ (mastodon-profile--item-json))))
+ (mastodon-profile--make-author-buffer
+ (alist-get 'account json)
+ nil nil nil nil max-id))))
+
+(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)))
+ (unless (string= img "/avatars/original/missing.png")
+ (mastodon-media--get-media-link-rendering img))))
+
+(defun mastodon-profile-show-user (user-handle)
+ "Query for USER-HANDLE from current status and show that user's profile."
+ (interactive
+ (list
+ (if (and (not (mastodon-tl--profile-buffer-p))
+ (not (mastodon-tl--property 'item-json :no-move)))
+ (user-error "Looks like there's no toot or user at point?")
+ (mastodon-tl-read-handle-annotated
+ (mastodon-profile--extract-users-handles (mastodon-profile--item-json))
+ "View profile of user [choose or enter any handle]: "))))
+ (if (not (or ; own profile has no need for item-json test:
+ (string= user-handle (mastodon-auth--get-account-name))
+ (mastodon-tl--profile-buffer-p)
+ (mastodon-tl--property 'item-json :no-move)))
+ (user-error "Looks like there's no toot or user at point?")
+ (let ((account (mastodon-profile--lookup-account-in-status
+ user-handle (mastodon-profile--item-json))))
+ (if (not account)
+ (user-error "Cannot find a user with handle %S" user-handle)
+ (progn
+ (message "Loading profile of user %s..." user-handle)
+ (mastodon-profile--make-author-buffer account))))))
+
+(defun mastodon-profile-my-profile ()
+ "Show the profile of the currently signed in user."
+ (interactive)
+ (message "Loading your profile...")
+ (let ((account (mastodon-profile--account-from-id
+ (mastodon-auth--get-account-id))))
+ (mastodon-profile--make-author-buffer account)))
+
+(defun mastodon-profile--format-user (tootv)
+ "Convert TOOTV into author-bylines and insert.
+Also insert their profile note.
+Used to view a user's followers and those they're following."
+ (let ((inhibit-read-only t))
+ (unless (seq-empty-p tootv)
+ (mapc
+ (lambda (toot)
+ (let ((start-pos (point)))
+ (insert
+ "\n"
+ (propertize
+ (mastodon-tl--byline-author `((account . ,toot)) :avatar nil :base)
+ 'byline 't
+ 'item-id (alist-get 'id toot)
+ 'base-item-id (mastodon-tl--item-id toot)
+ 'item-json toot))
+ (mastodon-media--inline-images start-pos (point))
+ (insert "\n"
+ (propertize
+ (mastodon-tl--render-text (alist-get 'note toot) nil)
+ 'item-json toot)
+ "\n")))
+ tootv))))
+
+(defun mastodon-profile--search-account-by-handle (handle)
+ "Return an account based on a user's HANDLE.
+If the handle does not match a search return then retun NIL."
+ (let* ((handle (if (string= "@" (substring handle 0 1))
+ (substring handle 1 (length handle))
+ handle))
+ (args `(("q" . ,handle)
+ ("type" . "accounts")))
+ (result (mastodon-http--get-json
+ (mastodon-http--api-v2 "search") args))
+ (matching-account (seq-remove
+ (lambda (x)
+ (not (string= handle (alist-get 'acct x))))
+ (alist-get 'accounts result))))
+ (when (eq 1 (length matching-account))
+ (elt matching-account 0))))
+
+(defun mastodon-profile--account-from-id (user-id)
+ "Request an account object relating to a USER-ID."
+ (mastodon-http--get-json
+ (mastodon-http--api (format "accounts/%s" user-id))))
+
+(defun mastodon-profile--extract-users-handles (status)
+ "Return all user handles found in STATUS.
+These include the author, author of reblogged entries and any user mentioned."
+ (when status
+ (let ((this-account (or (alist-get 'account status) ; status is a toot/notif
+ status)) ; status is a user listing
+ (mentions (mastodon-tl--field-status 'mentions status))
+ (reblog (mastodon-tl--field-status 'reblog status))
+ (grouped (when mastodon-group-notifications
+ ;; NB: looks like this only contains the grouped
+ ;; notifs for the current notif, which is not
+ ;; necessariliy all favers/boosters for a given item:
+ (let ((accounts (mastodon-tl--property 'notification-accounts
+ :nomove)))
+ (cl-loop for x in accounts
+ collect (alist-get 'acct x))))))
+ (seq-remove
+ (lambda (x) (string= x mastodon-active-user))
+ (seq-filter #'stringp
+ (seq-uniq
+ (seq-concatenate
+ 'list
+ (list (alist-get 'acct this-account))
+ grouped
+ (when reblog (mastodon-profile--extract-users-handles reblog))
+ (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."
+ (let* ((this-account (alist-get 'account status))
+ (reblog-account (alist-get 'account (alist-get 'reblog status)))
+ (mention-id (seq-some
+ (lambda (mention)
+ (when (string= handle (alist-get 'acct mention))
+ (alist-get 'id mention)))
+ (alist-get 'mentions status))))
+ (cond ((string= handle (alist-get 'acct this-account))
+ this-account)
+ ((string= handle (alist-get 'acct reblog-account))
+ reblog-account)
+ (mention-id
+ (mastodon-profile--account-from-id mention-id))
+ (t
+ (mastodon-profile--search-account-by-handle handle)))))
+
+;;; REMOVE
+
+(defun mastodon-profile-remove-user-from-followers (&optional id)
+ "Remove a user from your followers.
+Optionally provide the ID of the account to remove."
+ (interactive)
+ (let* ((account (unless id (mastodon-tl--property 'item-json :no-move)))
+ (id (or id (alist-get 'id account)))
+ (handle (let ((account (or account
+ (mastodon-profile--account-from-id id))))
+ (alist-get 'acct account)))
+ (url (mastodon-http--api
+ (format "accounts/%s/remove_from_followers" id))))
+ (when (y-or-n-p (format "Remove follower %s? " handle))
+ (let ((response (mastodon-http--post url)))
+ (mastodon-http--triage response
+ (lambda (_)
+ (message "Follower %s removed!" handle)))))))
+
+(defun mastodon-profile-remove-from-followers-at-point ()
+ "Prompt for a user in the item at point and remove from followers."
+ (interactive)
+ (let* ((handles (mastodon-profile--extract-users-handles
+ (mastodon-profile--item-json)))
+ (handle (completing-read "Remove from followers: " handles))
+ (account (mastodon-profile--lookup-account-in-status
+ handle (mastodon-profile--item-json)))
+ (id (alist-get 'id account)))
+ (mastodon-profile-remove-user-from-followers id)))
+
+(defun mastodon-profile-remove-from-followers-list ()
+ "Select a user from your followers and remove from followers.
+Currently limited to 100 handles. If not found, try
+`mastodon-search-query'."
+ (interactive)
+ (let* ((endpoint (format "accounts/%s/followers"
+ (mastodon-auth--get-account-id)))
+ (url (mastodon-http--api endpoint))
+ (response (mastodon-http--get-json url `(("limit" . "100"))))
+ (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response))
+ (choice (completing-read "Remove from followers: " handles))
+ (id (alist-get choice handles)))
+ (mastodon-profile-remove-user-from-followers id)))
+
+;;; PRIVATE NOTES
+
+(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."
+ (if (not (mastodon-tl--profile-buffer-p))
+ (error "Not viewing a profile")
+ (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--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--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)
+ (user-error "No private note for %s" handle)
+ ;; `mastodon-profile--display-private-note' takes 1 arg:
+ (funcall action-fun note))
+ ;; `mastodon-profile--post-private-note-to-account' takes 3 args:
+ (funcall action-fun id handle note))))
+
+;;; FAMILIAR FOLLOWERS
+
+(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--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 handles multiple IDs, but 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
+ (handles (mastodon-tl--map-alist 'acct accounts)))
+ (if (null handles)
+ (user-error "Looks like there are no familiar followers for this account")
+ (let ((choice (completing-read "Show profile of user: " handles)))
+ (mastodon-profile-show-user choice)))))
+
+;;; FEATURED TAGS
+
+(defun mastodon-profile-feature-tag ()
+ "Feature a tag on your profile."
+ (interactive)
+ (let* ((tag (read-string "Feature tag on your profile: "))
+ (endpoint (mastodon-http--api
+ (format "/tags/%s/feature" tag)))
+ (resp (mastodon-http--post endpoint)))
+ (mastodon-http--triage
+ resp (lambda (_resp)
+ (message "Tag #%s featured!" tag)))))
+
+(defun mastodon-profile--get-featured-tags (id)
+ "Get featured tags for user ID."
+ (let ((endpoint (mastodon-http--api
+ (format "/accounts/%s/featured_tags" id))))
+ (mastodon-http--get-json endpoint)))
+
+(defun mastodon-profile-load-featured-tag ()
+ "Prompt for a featured tag, and load posts containing it.
+Only works when viewing a user's profile."
+ (interactive)
+ (let* ((data (mastodon-profile--profile-json))
+ (id (alist-get 'id data))
+ (tags (mastodon-profile--get-featured-tags id))
+ (choice (completing-read "View user's featured tag: "
+ (mastodon-tl--map-alist 'name tags))))
+ (mastodon-profile-open-statuses-tagged choice)))
+
+(defun mastodon-profile-own-featured-tags ()
+ "Display your own featured tags.
+Load a timeline of your own featured tags with
+`mastodon-profile-load-featured-tag'when viewing your profile."
+ (interactive)
+ ;; GET /api/v1/featured_tags
+ (let* ((endpoint (mastodon-http--api "featured_tags"))
+ (tags (mastodon-http--get-json endpoint)))
+ (message "%S"
+ (mastodon-tl--map-alist 'name tags))))
+
+(provide 'mastodon-profile)
+;;; mastodon-profile.el ends here
--- /dev/null
+;;; mastodon-search.el --- Search functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Marty Hiatt
+;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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:
+
+;; A basic search function for mastodon.el
+
+;;; Code:
+(require 'json)
+(require 'mastodon-tl)
+(require 'mastodon-widget)
+
+(autoload 'mastodon-auth--access-token "mastodon-auth")
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-http--get-search-json "mastodon-http")
+(autoload 'mastodon-mode "mastodon")
+(autoload 'mastodon-tl--as-string "mastodon-tl")
+(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")
+(autoload 'mastodon-tl--timeline "mastodon-tl")
+(autoload 'mastodon-tl--toot "mastodon-tl")
+(autoload 'mastodon-tl--buffer-property "mastodon-tl")
+(autoload 'mastodon-http--api-v2 "mastodon-http")
+
+(defvar mastodon-toot--completion-style-for-mentions)
+(defvar mastodon-instance-url)
+(defvar mastodon-tl--link-keymap)
+(defvar mastodon-tl--horiz-bar)
+
+;; functions for completion of mentions in mastodon-toot
+
+(defun mastodon-search--get-user-info-@ (account)
+ "Get user handle, display name and account URL from ACCOUNT."
+ (list (concat "@" (cdr (assoc 'acct account)))
+ (cdr (assoc 'url account))
+ (cdr (assoc 'display_name account))))
+
+(defun mastodon-search--search-accounts-query (query)
+ "Prompt for a search QUERY and return accounts synchronously.
+Returns a nested list containing user handle, display name, and URL."
+ (let* ((url (mastodon-http--api "accounts/search"))
+ (response
+ (mastodon-http--get-json
+ url
+ `(("q" . ,query) ;; NB: nil can break params (but works for me)
+ ,(when (string= "following"
+ mastodon-toot--completion-style-for-mentions)
+ '("following" . "true")))
+ :silent)))
+ (mapcar #'mastodon-search--get-user-info-@ response)))
+
+;; functions for tags completion:
+
+(defun mastodon-search--search-tags-query (query)
+ "Return an alist containing tag strings plus their URLs.
+QUERY is the string to search."
+ (let* ((url (mastodon-http--api-v2 "search"))
+ (params `(("q" . ,query) ("type" . "hashtags")))
+ (response (mastodon-http--get-json url params :silent))
+ (tags (alist-get 'hashtags response)))
+ (mapcar #'mastodon-search--get-hashtag-info tags)))
+
+;; trending tags
+
+(defun mastodon-search-trending-tags ()
+ "Display a list of tags trending on your instance."
+ (interactive)
+ (mastodon-search--view-trending "tags"
+ #'mastodon-search--print-tags))
+
+(defun mastodon-search-trending-statuses ()
+ "Display a list of statuses trending on your instance."
+ (interactive)
+ (mastodon-search--view-trending "statuses"
+ #'mastodon-tl--timeline))
+
+(defun mastodon-search-trending-links ()
+ "Display a list of links trending on your instance."
+ (interactive)
+ (mastodon-search--view-trending "links"
+ #'mastodon-search--render-links))
+
+(defun mastodon-search--render-links (links)
+ "Render trending LINKS."
+ (cl-loop for l in links
+ do (mastodon-search--render-link l)))
+
+(defun mastodon-search--render-link (link)
+ "Render a trending LINK."
+ (let-alist link
+ (insert
+ (propertize
+ (mastodon-tl--render-text
+ (concat "<a href=\"" .url "\">" .url "</a>\n" .title)
+ link)
+ 'item-type 'link
+ 'item-json link
+ 'shr-url .url
+ 'byline t ;; nav
+ 'help-echo
+ (substitute-command-keys
+ "\\[`mastodon-search-load-link-posts'] to view a link's timeline"))
+ ;; TODO: display card link author here
+ "\n\n")))
+
+(defun mastodon-search-load-link-posts ()
+ "Load timeline of posts containing link at point."
+ (interactive)
+ (let* ((url (mastodon-tl--property 'shr-url)))
+ (mastodon-tl--link-timeline url)))
+
+(defun mastodon-search--view-trending (type print-fun)
+ "Display a list of tags trending on your instance.
+TYPE is a string, either tags, statuses, or links.
+PRINT-FUN is the function used to print the data from the response."
+ (let* ((url (mastodon-http--api (format "trends/%s" type)))
+ ;; max for statuses = 40, for others = 20
+ (limit (if (string= type "statuses")
+ '("limit" . "40")
+ '("limit" . "20")))
+ (offset '(("offset" . "0")))
+ (params (push limit offset))
+ (data (mastodon-http--get-json url params))
+ (buffer (get-buffer-create
+ (format "*mastodon-trending-%s*" type))))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec (buffer-name buffer)
+ (format "trends/%s" type)
+ print-fun nil params)
+ (mastodon-search--insert-heading "trending" type)
+ (funcall print-fun data)
+ (unless (string= type "statuses")
+ (goto-char (point-min))))))
+
+;; functions for mastodon search
+
+(defun mastodon-search--insert-heading (str &optional type)
+ "Insert STR as a heading.
+Optionally add string TYPE after HEADING."
+ (insert
+ (mastodon-search--format-heading str type)))
+
+(defun mastodon-search--format-heading (str &optional type no-newline)
+ "Format STR as a heading.
+Optionally add string TYPE after HEADING.
+NO-NEWLINE means don't add add a newline at end."
+ (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n "
+ (upcase str) " "
+ (when type (upcase type)) "\n"
+ " " mastodon-tl--horiz-bar (unless no-newline "\n"))
+ 'success))
+
+(defvar mastodon-search-types
+ '("statuses" "accounts" "hashtags"))
+
+(defun mastodon-search-query (query &optional type limit
+ following account-id offset)
+ "Prompt for a search QUERY and return accounts, statuses, and hashtags.
+TYPE is a member of `mastodon-search-types'.
+LIMIT is a number as string, up to 40, with 40 the default.
+FOLLOWING means limit to accounts followed, for \"accounts\" type only.
+A single prefix arg also sets FOLLOWING to true.
+ACCOUNT-ID means limit search to that account, for \"statuses\" type only.
+OFFSET is a number as string, means to skip that many results. It
+is used for pagination."
+ ;; TODO: handle no results
+ (interactive "sSearch mastodon for: ")
+ (let* ((url (mastodon-http--api-v2 "search"))
+ (following (when (or following (equal current-prefix-arg '(4)))
+ "true"))
+ (type (or type
+ (if (equal current-prefix-arg '(4))
+ "accounts" ; if FOLLOWING, must be "accounts"
+ (completing-read "Search type: "
+ mastodon-search-types nil :match))))
+ (limit (or limit "40"))
+ (offset (or offset "0"))
+ (buffer (format "*mastodon-search-%s-%s*" type query))
+ (params `(("q" . ,query)
+ ,@(when type `(("type" . ,type)))
+ ,@(when limit `(("limit" . ,limit)))
+ ,@(when offset `(("offset" . ,offset)))
+ ,@(when following `(("following" . ,following)))
+ ,@(when account-id `(("account_id" . ,account-id)))))
+ (response (mastodon-http--get-json url params))
+ (items (alist-get (intern type) response)))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-search-mode)
+ (mastodon-search--insert-heading "search")
+ (mastodon-widget--create
+ "Results"
+ '(accounts hashtags statuses)
+ (intern type)
+ (lambda (widget &rest _ignore)
+ (let ((value (widget-value widget)))
+ (mastodon-search-query query (symbol-name value)))))
+ (insert "\n\n")
+ (cond ((string= type "accounts")
+ (mastodon-search--render-response items type buffer params
+ 'mastodon-views--insert-users-propertized-note
+ 'mastodon-views--insert-users-propertized-note))
+ ((string= type "hashtags")
+ (mastodon-search--render-response items type buffer params
+ 'mastodon-search--print-tags
+ 'mastodon-search--print-tags))
+ ((string= type "statuses")
+ (mastodon-search--render-response items type buffer params
+ #'mastodon-tl--timeline
+ #'mastodon-tl--timeline)))
+ (goto-char (point-min))
+ (message
+ (substitute-command-keys
+ "\\[mastodon-search-query-cycle] to cycle result types.")))))
+
+(defun mastodon-search-insert-no-results (&optional thing)
+ "Insert a no results message for object THING."
+ (let ((thing (or thing "items")))
+ (insert
+ (propertize (format "Looks like search returned no %s." thing)
+ 'face 'mastodon-toot-docs-face))))
+
+(defun mastodon-search--render-response (data type buffer params
+ insert-fun update-fun)
+ "Call INSERT-FUN on DATA of result TYPE if non-nil.
+BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'."
+ (if (not data)
+ (mastodon-search-insert-no-results type)
+ (funcall insert-fun data))
+ (mastodon-tl--set-buffer-spec buffer "search"
+ update-fun nil params))
+
+(defun mastodon-search--buf-type ()
+ "Return search buffer type, a member of `mastodon-search-types'."
+ ;; called in `mastodon-tl--get-buffer-type'
+ (let* ((spec (mastodon-tl--buffer-property 'update-params)))
+ (alist-get "type" spec nil nil #'string=)))
+
+(defun mastodon-search-query-cycle ()
+ "Cycle through search types: accounts, hashtags, and statuses."
+ (interactive)
+ (let* ((spec (mastodon-tl--buffer-property 'update-params))
+ (type (alist-get "type" spec nil nil #'string=))
+ (query (alist-get "q" spec nil nil #'string=)))
+ (cond ((string= type "hashtags")
+ (mastodon-search-query query "accounts"))
+ ((string= type "accounts")
+ (mastodon-search-query query "statuses"))
+ ((string= type "statuses")
+ (mastodon-search-query query "hashtags")))))
+
+(defun mastodon-search-query-accounts-followed (query)
+ "Run an accounts search QUERY, limited to your followers."
+ (interactive "sSearch mastodon for: ")
+ (mastodon-search-query query "accounts" :following))
+
+(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'."
+ (cl-loop for acct in json
+ do (insert (concat (mastodon-search--propertize-user acct note)
+ mastodon-tl--horiz-bar
+ "\n\n"))))
+
+(defun mastodon-search--propertize-user (acct &optional note)
+ "Propertize display string for ACCT, optionally including profile NOTE."
+ (let* ((user (mastodon-search--get-user-info acct))
+ (id (alist-get 'id acct)))
+ (propertize
+ (concat
+ (propertize (car user)
+ 'face 'mastodon-display-name-face
+ 'byline t
+ 'item-type 'user
+ 'item-id id) ; for prev/next nav
+ " : \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"
+ (when note
+ (mastodon-tl--render-text (cadddr user) acct))
+ "\n")
+ 'item-json acct))) ; for compat w other processing functions
+
+(defun mastodon-search--print-tags (tags)
+ "Print TAGS data as returned from a \"hashtags\" search query."
+ (let ((tags-list (mapcar #'mastodon-search--get-hashtag-info tags)))
+ (mastodon-search--print-tags-list tags-list)))
+
+(defun mastodon-search--print-tags-list (tags-list)
+ "Insert a propertized list of TAGS-LIST."
+ (cl-loop for el in tags-list
+ do (insert
+ " : "
+ (propertize (concat "#" (car el))
+ 'face '(:box t)
+ 'mouse-face 'highlight
+ 'mastodon-tag (car el)
+ 'mastodon-tab-stop 'hashtag
+ 'item-type 'tag ; for next/prev nav
+ 'byline t ; for next/prev nav
+ 'help-echo (concat "Browse tag #" (car el))
+ 'keymap mastodon-tl--link-keymap)
+ " : \n\n")))
+
+(defun mastodon-search--get-user-info (account)
+ "Get user handle, display name, account URL and profile note from ACCOUNT."
+ (list (mastodon-tl--display-or-uname account)
+ (alist-get 'acct account)
+ (alist-get 'url account)
+ (alist-get 'note account)))
+
+(defun mastodon-search--get-hashtag-info (tag)
+ "Get hashtag name and URL from TAG."
+ (list (alist-get 'name tag)
+ (alist-get 'url tag)))
+
+;; These functions are all unused!
+
+;; (defun mastodon-search--get-status-info (status)
+;; "Get ID, timestamp, content, and spoiler from STATUS."
+;; (list (alist-get 'id status)
+;; (alist-get 'created_at status)
+;; (alist-get 'spoiler_text status)
+;; (alist-get 'content status)))
+
+;; (defun mastodon-search--id-from-status (status)
+;; "Fetch the id from a STATUS returned by a search call to the server.
+;; We use this to fetch the complete status from the server."
+;; (alist-get 'id status))
+
+;; (defun mastodon-search--full-status-from-id (id)
+;; "Fetch the full status with id ID from the server.
+;; This allows us to access the full account etc. details and to
+;; render them properly."
+;; (let* ((url (mastodon-http--api (format "statuses/%s" id)))
+;; ;; (concat mastodon-instance-url "/api/v1/statuses/"
+;; ;; (mastodon-tl--as-string id)))
+;; (json (mastodon-http--get-json url)))
+;; json))
+
+(defvar mastodon-search-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-c") #'mastodon-search-query-cycle)
+ map)
+ "Keymap for `mastodon-search-mode'.")
+
+(define-minor-mode mastodon-search-mode
+ "Toggle mastodon search minor mode.
+This minor mode is used for mastodon search pages to adds a keybinding."
+ :init-value nil
+ :lighter " Search"
+ :keymap mastodon-search-mode-map
+ :group 'mastodon
+ :global nil)
+
+(provide 'mastodon-search)
+;;; mastodon-search.el ends here
--- /dev/null
+;;; mastodon-tl.el --- Timeline functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-tl.el provides timeline functions.
+
+;;; Code:
+
+(require 'shr)
+(require 'thingatpt) ; for word-at-point
+(require 'time-date)
+(require 'cl-lib)
+(require 'mastodon-iso)
+(require 'mpv nil :no-error)
+(require 'url-cache)
+
+(autoload 'mastodon-mode "mastodon")
+(autoload 'mastodon-notifications-get "mastodon")
+(autoload 'mastodon-url-lookup "mastodon")
+(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-notifications--filter-types-list "mastodon-notifications")
+(autoload 'mastodon-notifications-get-mentions "mastodon-notifications")
+(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-open-statuses-no-reblogs "mastodon-profile")
+(autoload 'mastodon-profile--profile-json "mastodon-profile")
+(autoload 'mastodon-profile--search-account-by-handle "mastodon-profile")
+(autoload 'mastodon-profile--item-json "mastodon-profile")
+(autoload 'mastodon-profile--view-author-profile "mastodon-profile")
+(autoload 'mastodon-profile-mode "mastodon-profile")
+(autoload 'mastodon-search--get-user-info "mastodon-search")
+(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-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-search--buf-type "mastodon-search")
+(autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ; for search pagination
+(autoload 'mastodon-http--get-response "mastodon-http")
+(autoload 'mastodon-search--insert-heading "mastodon-search")
+(autoload 'mastodon-media--process-full-sized-image-response "mastodon-media")
+(autoload 'mastodon-search-trending-statuses "mastodon-search")
+(autoload 'mastodon-search--format-heading "mastodon-search")
+(autoload 'mastodon-media--image-or-cached "mastodon-media")
+(autoload 'mastodon-toot--base-toot-or-item-json "mastodon-toot")
+(autoload 'mastodon-search-load-link-posts "mastodon-search")
+(autoload 'mastodon-notifications--current-type "mastodon-notifications")
+(autoload 'mastodon-notifications--timeline "mastodon-notifications")
+(autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications")
+(autoload 'mastodon-search--print-tags "mastodon-search")
+(autoload 'mastodon-profile-show-user "mastodon-profile")
+(autoload 'mastodon-toot--own-toot-p "mastodon-toot")
+
+(defvar mastodon-toot--visibility)
+(defvar mastodon-toot-mode)
+(defvar mastodon-active-user)
+(defvar mastodon-images-in-notifs)
+(defvar mastodon-group-notifications)
+(defvar mastodon-profiles-quote-policy-types)
+
+(when (require 'mpv nil :no-error)
+ (declare-function mpv-start "mpv"))
+(defvar mastodon-mode-map)
+(defvar mastodon-instance-url)
+(defvar mastodon-toot-timestamp-format)
+(defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this
+(defvar mastodon-media--enable-image-caching)
+(defvar mastodon-media--generic-broken-image-data)
+(defvar mastodon-media--sensitive-image-data)
+(defvar mastodon-media--attachments)
+
+\f
+;;; CUSTOMIZES
+
+(defgroup mastodon-tl nil
+ "Timelines in Mastodon."
+ :prefix "mastodon-tl-"
+ :group 'mastodon)
+
+(defcustom mastodon-tl--enable-relative-timestamps t
+ "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."
+ :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."
+ :type '(boolean :tag "Enable using proportional rather than fixed \
+width fonts when rendering HTML text"))
+
+(defcustom mastodon-tl--no-fill-on-render nil
+ "Non-nil to disable filling by shr.el while rendering toot body.
+Use this if your setup isn't compatible with shr's window width filling."
+ :type '(boolean))
+
+(defcustom mastodon-tl--display-media-p t
+ "A boolean value stating whether to show media in timelines."
+ :type 'boolean)
+
+(defcustom mastodon-tl--display-caption-not-url-when-no-media t
+ "Display an image's caption rather than URL.
+Only has an effect when `mastodon-tl--display-media-p' is set to
+nil."
+ :type 'boolean)
+
+(defcustom mastodon-tl--show-avatars nil
+ "Whether to enable display of user avatars in timelines."
+ :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 'boolean)
+
+(defcustom mastodon-tl--symbols
+ `((reply . ("💬" . "R"))
+ (boost . ("🔁" . "B"))
+ (reblog . ("🔁" . "B")) ;; server compat
+ (favourite . ("⭐" . "F"))
+ (bookmark . ("🔖" . "K"))
+ (media . ("📹" . "[media]"))
+ (verified . ("✓" . "V"))
+ (locked . ("🔒" . "[locked]"))
+ (private . ("🔒" . "[followers]"))
+ (mention . ("@" . "[mention]"))
+ (direct . ("✉" . "[direct]"))
+ (edited . ("✍" . "[edited]"))
+ (update . ("✍" . "[edited]")) ;; server compat
+ (status . ("🔔" . "[posted]"))
+ (replied . ("⬇" . "↓"))
+ (reply-bar . ("┃" . "|"))
+ (poll . ("📊" . "[poll]"))
+ (follow . ("👤" . "+"))
+ (follow_request . ("👤" . "+"))
+ (severed_relationships . ("🔗" . "//"))
+ (moderation_warning . ("⚠" . "!!"))
+ (bot . ("🤖" . "[bot]"))
+ (quote . (,(propertize "“" 'face
+ '(t :inherit success :weight bold
+ :height 1.8))))
+ (quoted_update . ("✍" . "[edited]")))
+ "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 (cons string string)))
+
+(defcustom mastodon-tl-position-after-update nil
+ "Defines where `point' should be located after a timeline update.
+Valid values are:
+- nil Top/bottom depending on timeline type
+- keep-point Keep original position of point
+- last-old-toot The last toot before the new ones"
+ :type '(choice (const :tag "Top/bottom depending on timeline type" nil)
+ (const :tag "Keep original position of point" keep-point)
+ (const :tag "The last toot before the new ones" last-old-toot)))
+
+(defcustom mastodon-tl--timeline-posts-count "20"
+ "Number of posts to display when loading a timeline.
+Must be an integer between 20 and 40 inclusive."
+ :type '(string))
+
+(defcustom mastodon-tl--hide-replies nil
+ "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'."
+ :type '(boolean :tag "Whether to hide replies from the timelines."))
+
+(defcustom mastodon-tl--highlight-current-toot nil
+ "Whether to highlight the toot at point. Uses `cursor-face' special property."
+ :type '(boolean))
+
+(defcustom mastodon-tl--expand-content-warnings 'server
+ "Whether to expand content warnings by default.
+The API returns data about this setting on the server, but no
+means to set it, so we roll our own option here to override the
+server setting if desired. If you change the server setting and
+want it to be respected by mastodon.el, you'll likely need to
+either unset `mastodon-profile-acccount-preferences-data' and
+re-load mastodon.el, or restart Emacs."
+ :type '(choice (const :tag "true" t)
+ (const :tag "false" nil)
+ (const :tag "follow server setting" server)))
+
+(defcustom mastodon-tl--tag-timeline-tags nil
+ "A list of up to four tags for use with `mastodon-tl-followed-tags-timeline'."
+ :type '(repeat string))
+
+(defcustom mastodon-tl--load-full-sized-images-in-emacs t
+ "Whether to load full-sized images inside Emacs.
+Full-sized images are loaded when you hit return on or click on
+an image in a timeline.
+If nil, mastodon.el will instead call `shr-browse-image', which
+respects the user's `browse-url' settings."
+ :type '(boolean))
+
+(defcustom mastodon-tl--remote-local-domains nil
+ "A list of domains to view the local timelines of.
+See `mastodon-tl-get-remote-local-timeline' for view remote local domains."
+ :type '(repeat string))
+
+(defcustom mastodon-tl--fold-toots-at-length 1200
+ "Length, in characters, to fold a toot at.
+Longer toots will be folded and the remainder replaced by a
+\"read more\" button. If the value is nil, don't fold at all."
+ :type '(integer))
+
+\f
+;;; 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.")
+
+(defvar-local mastodon-tl--after-update-marker nil
+ "Marker defining the position of point after the update is done.")
+
+(defvar-local mastodon-tl--timestamp-next-update nil
+ "The timestamp when the buffer should next be scanned to update the timestamps.")
+
+(defvar-local mastodon-tl--timestamp-update-timer nil
+ "The timer that, when set will scan the buffer to update the timestamps.")
+
+(defvar mastodon-tl--horiz-bar
+ (make-string 12
+ (if (char-displayable-p ?―) ?― ?-)))
+
+\f
+;;; 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)
+ 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 (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)
+ ;; keep new my-profile binding; shr 'O' doesn't work here anyway
+ (define-key map (kbd "O") #'mastodon-profile-my-profile)
+ ;; 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 [remap shr-browse-url] #'mastodon-url-lookup)
+ (define-key map (kbd "M-RET") #'mastodon-search-load-link-posts)
+ 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 (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)
+ ;; 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] #'mastodon-tl-view-full-image-or-play-video)
+ ;; 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)
+ ;; 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") #'mastodon-tl-copy-image-caption)
+ (define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image)
+ (define-key map (kbd "<C-return>") #'mastodon-tl-mpv-play-video-at-point)
+ (define-key map (kbd "<mouse-2>") #'mastodon-tl-click-image-or-video)
+ 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--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 "RET") #'mastodon-profile-get-toot-author)
+ (define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image)
+ map))
+ "The keymap to be set for the author byline.
+It is active where point is placed by `mastodon-tl-goto-next-item.'")
+
+(require 'image-mode)
+
+(defvar mastodon-image-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map image-mode-map)
+ (define-key map (kbd ">") #'mastodon-tl-next-full-image)
+ (define-key map (kbd "<") #'mastodon-tl-prev-full-image)
+ (define-key map (kbd ".") #'mastodon-tl-next-full-image)
+ (define-key map (kbd ",") #'mastodon-tl-prev-full-image)
+ ;; matches view full image binding in main keymap:
+ (define-key map (kbd "=") #'mastodon-tl-next-full-image)
+ (define-key map (kbd "-") #'mastodon-tl-prev-full-image)
+ (define-key map (kbd "<right>") #'mastodon-tl-next-full-image)
+ (define-key map (kbd "<left>") #'mastodon-tl-prev-full-image)
+ map))
+
+\f
+;;; MACROS
+
+(defmacro with-mastodon-buffer (buffer mode-fun other-window &rest body)
+ "Evaluate BODY in a new or existing buffer called BUFFER.
+MODE-FUN is called to set the major mode.
+OTHER-WINDOW means call `switch-to-buffer-other-window' rather
+than `pop-to-buffer'."
+ (declare (debug t)
+ (indent 3))
+ `(with-current-buffer (get-buffer-create ,buffer)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (funcall ,mode-fun)
+ (remove-overlays) ; video overlays
+ ,@body
+ ;; return result of switching buffer:
+ (if ,other-window
+ (switch-to-buffer-other-window ,buffer)
+ (pop-to-buffer ,buffer '(display-buffer-same-window))))))
+
+(defmacro mastodon-tl--do-if-item (&rest body)
+ "Execute BODY if we have an item at point."
+ (declare (debug t))
+ `(if (and (not (mastodon-tl--profile-buffer-p))
+ (not (mastodon-tl--property 'item-json))) ; includes users but not tags
+ (user-error "Looks like there's no item at point?")
+ ,@body))
+
+\f
+;;; NAV
+
+(defun mastodon-tl-scroll-up-command ()
+ "Call `scroll-up-command', loading more toots if necessary.
+If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'."
+ (interactive)
+ (if (not (eq (point) (point-max)))
+ (scroll-up-command)
+ (mastodon-tl--more)
+ (scroll-up-command)))
+
+(defun mastodon-tl-next-tab-item (&optional previous)
+ "Move to the next interesting item.
+This could be the next toot, link, or image; whichever comes first.
+Don't move if nothing to move to is found, i.e. near the end of the buffer.
+This also skips tab items in invisible text, i.e. hidden spoiler text.
+PREVIOUS means move to previous item."
+ (interactive)
+ (let (next-range
+ (search-pos (point)))
+ (while (and (setq next-range
+ (mastodon-tl--find-next-or-previous-property-range
+ 'mastodon-tab-stop search-pos previous))
+ (get-text-property (car next-range) 'invisible)
+ (setq search-pos (if previous
+ (1- (car next-range))
+ (1+ (cdr next-range)))))
+ ;; do nothing, all the action is in the while condition
+ )
+ (if (null next-range)
+ (user-error "Nothing else here")
+ (goto-char (car next-range))
+ (message "%s" (mastodon-tl--property 'help-echo :no-move)))))
+
+(defun mastodon-tl-previous-tab-item ()
+ "Move to the previous interesting item.
+This could be the previous toot, link, or image; whichever comes
+first. Don't move if nothing else to move to is found, i.e. near
+the start of the buffer. This also skips tab items in invisible
+text, i.e. hidden spoiler text."
+ (interactive)
+ (mastodon-tl-next-tab-item :previous))
+
+(defun mastodon-tl--goto-item-pos (find-pos refresh &optional pos)
+ "Search for item with function FIND-POS.
+If search returns nil, execute REFRESH function.
+Optionally start from POS."
+ (let* ((npos ; toot/user items have byline:
+ (funcall find-pos
+ (or pos
+ (if (save-excursion
+ (when (not (= 1 (point)))
+ (backward-char 1))
+ (looking-at "\u2068"))
+ (1- (point))
+ (point)))
+ ;; FIXME: we need to fix item-type?
+ ;; 'item-type ; breaks nav to last item in a view?
+ 'byline
+ (current-buffer)))
+ (max-lisp-eval-depth 4)) ;; clamp down on endless loops
+ (if npos
+ (if (not (get-text-property npos 'item-type)) ; generic
+ ;; FIXME let's make refresh &optional and only call refresh/recur
+ ;; if non-nil:
+ (mastodon-tl--goto-item-pos find-pos refresh npos)
+ (goto-char npos)
+ ;; force display of help-echo on moving to a toot byline:
+ (mastodon-tl--message-help-echo)
+ (when (looking-at "\u2068")
+ (forward-char 1)))
+ (condition-case nil
+ (funcall refresh)
+ (error "No more items")))))
+
+(defun mastodon-tl-goto-next-item (&optional no-refresh)
+ "Jump to next item.
+Load more items it no next item.
+NO-REFRESH means do no not try to load more items if no next item
+found."
+ (interactive)
+ (condition-case nil
+ (mastodon-tl--goto-item-pos 'next-single-property-change
+ (unless no-refresh 'mastodon-tl--more))
+ (t (error "No more items"))))
+
+(defun mastodon-tl-goto-prev-item (&optional no-refresh)
+ "Jump to previous item.
+Update if no previous items.
+NO-REFRESH means do no not try to load more items if no next item
+found."
+ (interactive)
+ (condition-case nil
+ (mastodon-tl--goto-item-pos 'previous-single-property-change
+ (unless no-refresh 'mastodon-tl-update))
+ (t (error "No more items"))))
+
+(defun mastodon-tl--goto-first-item ()
+ "Jump to first toot or item in buffer.
+Used on initializing a timeline or thread."
+ (goto-char (point-min))
+ (condition-case nil
+ (mastodon-tl--goto-item-pos 'next-single-property-change
+ 'next-line)
+ (t (error "No item"))))
+
+\f
+;;; TIMELINES
+
+(defun mastodon-tl-get-federated-timeline (&optional prefix local max-id)
+ "Open federated timeline.
+If LOCAL, get only local timeline.
+With a single PREFIX arg, hide-replies.
+With a double PREFIX arg, only show posts with media."
+ (interactive "p")
+ (let ((params
+ `(("limit" . ,mastodon-tl--timeline-posts-count)
+ ,@(when (eq prefix 16)
+ '(("only_media" . "true")))
+ ,@(when local
+ '(("local" . "true")))
+ ,@(when max-id
+ `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))))
+ (message "Loading federated timeline...")
+ (mastodon-tl--init (if local "local" "federated")
+ "timelines/public" 'mastodon-tl--timeline nil
+ params
+ (when (eq prefix 4) t))))
+
+(defun mastodon-tl-get-home-timeline (&optional arg max-id)
+ "Open home timeline.
+With a single prefix ARG, hide replies.
+MAX-ID is a flag to add the max_id pagination parameter."
+ (interactive "p")
+ (let* ((params
+ `(("limit" . ,mastodon-tl--timeline-posts-count)
+ ,@(when max-id
+ `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))))
+ (message "Loading home timeline...")
+ (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil
+ params
+ (when (eq arg 4) t))))
+
+(defun mastodon-tl-get-remote-local-timeline (&optional endpoint)
+ "Prompt for an instance domain and try to display its local timeline.
+You can enter any working instance domain. Domains that you want
+to regularly load can be stored in
+`mastodon-tl--remote-local-domains' for easy access with completion.
+Note that some instances do not make their local timelines public, in
+which case this will not work.
+To interact with any item, you must view it from your own
+instance, which you can do with
+`mastodon-tl-view-item-on-own-instance'.
+Optionally, provide API ENDPOINT."
+ (interactive)
+ (let* ((domain (completing-read "Domain for remote local tl: "
+ mastodon-tl--remote-local-domains))
+ (params `(("limit" . ,mastodon-tl--timeline-posts-count)
+ ("local" . "true")))
+ (buf (concat "remote-local-" domain))
+ (known (member domain
+ (mastodon-http--get-json
+ (mastodon-http--api "instance/peers")))))
+ ;; condition-case doesn't work here, so i added basic error handling to
+ ;; `mastodon-tl--init*' instead
+ (when (or known
+ (y-or-n-p
+ "Domain appears unknown to your instance. Proceed?"))
+ (mastodon-tl--init buf
+ (or endpoint "timelines/public")
+ 'mastodon-tl--timeline nil
+ params nil domain))))
+
+(defun mastodon-tl-remote-tag-timeline (&optional tag)
+ "Call `mastodon-tl-get-remote-local-timeline' but for a TAG timeline."
+ (interactive)
+ (let* ((tag (or tag (read-string "Tag: ")))
+ (endpoint (format "timelines/tag/%s" tag)))
+ (mastodon-tl-get-remote-local-timeline endpoint)))
+
+(defun mastodon-tl-view-item-on-own-instance ()
+ "Load current toot on your own instance.
+Use this to re-load remote-local items in order to interact with them."
+ (interactive)
+ (mastodon-tl--do-if-item
+ (let* ((toot (mastodon-tl--property 'item-json))
+ (uri (mastodon-tl--field 'uri toot)))
+ (mastodon-url-lookup uri))))
+
+(defun mastodon-tl-get-local-timeline (&optional prefix max-id)
+ "Open local timeline.
+With a single PREFIX arg, hide-replies.
+With a double PREFIX arg, only show posts with media.
+MAX-ID is a flag to add the max_id pagination parameter."
+ (interactive "p")
+ (message "Loading local timeline...")
+ (mastodon-tl-get-federated-timeline prefix :local max-id))
+
+(defun mastodon-tl-get-tag-timeline (&optional prefix tag)
+ "Prompt for tag and opens its timeline.
+Optionally load TAG timeline directly.
+With a single PREFIX arg, only show posts with media.
+With a double PREFIX arg, limit results to your own instance."
+ (interactive "p")
+ (let* ((word (or (word-at-point) ""))
+ (input (or tag (read-string
+ (format "Load timeline for tag (%s): " word))))
+ (tag (or tag (if (string-empty-p input) word input))))
+ (message "Loading timeline for #%s..." tag)
+ (mastodon-tl--show-tag-timeline prefix tag)))
+
+(defun mastodon-tl--show-tag-timeline (&optional prefix tag)
+ "Opens a new buffer showing the timeline of posts with hastag TAG.
+If TAG is a list, show a timeline for all tags.
+With a single PREFIX arg, only show posts with media.
+With a double PREFIX arg, limit results to your own instance."
+ (let ((params
+ `(("limit" . ,mastodon-tl--timeline-posts-count)
+ ,@(when (eq prefix 4)
+ '(("only_media" . "true")))
+ ,@(when (eq prefix 16)
+ '(("local" . "true"))))))
+ (when (listp tag)
+ (let ((list (mastodon-http--build-array-params-alist "any[]" (cdr tag))))
+ (while list
+ (push (pop list) params))))
+ (mastodon-tl--init
+ (if (listp tag) "tags-multiple" (concat "tag-" tag))
+ (concat "timelines/tag/" (if (listp tag) (car tag) tag)) ; must be /tag/:sth
+ 'mastodon-tl--timeline nil params)))
+
+(defun mastodon-tl--link-timeline (url)
+ "Load a link timeline, displaying posts containing URL."
+ (let ((params `(("url" . ,url))))
+ (mastodon-tl--init "links" "timelines/link"
+ 'mastodon-tl--timeline nil
+ params)))
+
+(defun mastodon-tl-announcements ()
+ "Display announcements from your instance."
+ (interactive)
+ (mastodon-tl--init "announcements" "announcements"
+ 'mastodon-tl--timeline nil nil nil nil :no-byline))
+
+\f
+;;; BYLINES, etc.
+
+(defun mastodon-tl--message-help-echo ()
+ "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
+ (mastodon-tl--property 'item-json :no-move)))
+ (echo (mastodon-tl--property 'help-echo :no-move)))
+ (when (not (string= "" echo)) ; not for followers/following in profile
+ (unless (or (string= type "follow_request")
+ (string= type "follow")) ; no counts for these
+ (message "%s" echo)))))
+
+(defun mastodon-tl--unicode-wrap (str)
+ "Wrap STR in unicode directional isolates."
+ ;; see https://unicode.org/reports/tr9/#Explicit_Directional_Isolates
+ ;; via Tusky (again! thanks)
+ ;; https://codeberg.org/tusky/Tusky/src/commit/16cef3d6202648e4fd67f06ef0fb1d0a2d04b68f/app/src/main/java/com/keylesspalace/tusky/util/StringUtils.kt#L65
+ (concat "\u2068" str "\u2069"))
+
+(defun mastodon-tl--byline-username (toot)
+ "Format a byline username from account in TOOT.
+TOOT may be account data, or toot data, in which case acount data
+is extracted from it."
+ (let ((data (or (alist-get 'account toot)
+ toot))) ;; grouped nofifs use account data directly
+ (let-alist data
+ (let ((disp (if (and .display_name
+ (not (string-empty-p .display_name)))
+ (mastodon-tl--unicode-wrap .display_name)
+ .username)))
+ (propertize disp
+ 'face 'mastodon-display-name-face
+ ;; enable playing of videos when point is on byline:
+ ;; 'attachments (mastodon-tl--get-attachments-for-byline toot)
+ 'keymap mastodon-tl--byline-link-keymap
+ ;; echo faves count when point on post author name:
+ ;; which is where --goto-next-toot puts point.
+ 'help-echo
+ ;; 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--format-byline-help-echo data)))))))
+
+(defun mastodon-tl--byline-handle (toot &optional domain string face)
+ "Format a byline handle from account in TOOT.
+DOMAIN is optionally added to the handle.
+ACCOUNT is optionally acccount data to use.
+STRING is optionally the string to propertize, it is used to make
+username rather than handle buttons.
+FACE is optionally the face to use.
+The last two args allow for display a username as a clickable
+handle."
+ (let-alist (or (alist-get 'account toot)
+ toot) ;; grouped notifs
+ (let ((str (or string
+ (concat "@" .acct
+ (when domain
+ (concat "@"
+ (url-host
+ (url-generic-parse-url .url))))))))
+ (mastodon-tl--buttonify-link
+ (mastodon-tl--unicode-wrap str)
+ 'face (or face 'mastodon-handle-face)
+ 'mastodon-tab-stop 'user-handle
+ 'shr-url .url
+ 'mastodon-handle (concat "@" .acct)
+ 'help-echo (concat "Browse user profile of @" .acct)))))
+
+(defun mastodon-tl--byline-uname-+-handle (data &optional domain)
+ "Concatenate a byline username and handle.
+DATA is the (toot) data to use.
+DOMAIN is optionally a domain for the handle.
+ACCOUNT is optionally acccount data to use."
+ (concat (mastodon-tl--byline-username data)
+ " (" (mastodon-tl--byline-handle data domain) ")"))
+
+(defun mastodon-tl--display-or-uname (account)
+ "Return display name or username from ACCOUNT data."
+ (if (not (string-empty-p (alist-get 'display_name account)))
+ (alist-get 'display_name account)
+ (alist-get 'username account)))
+
+(defun mastodon-tl--byline-author (toot &optional avatar domain base)
+ "Propertize author of TOOT.
+With arg AVATAR, include the account's avatar image.
+When DOMAIN, force inclusion of user's domain in their handle.
+BASE means to use data from the base item (reblog slot) if possible.
+If BASE is nil, we are a boosted byline, so show less info.
+ACCOUNT is optionally acccount data to use."
+ (let* ((data (if base
+ (mastodon-tl--toot-or-base toot)
+ toot))
+ (account (alist-get 'account data))
+ (uname (mastodon-tl--display-or-uname account)))
+ (concat
+ ;; avatar insertion moved up to `mastodon-tl--byline' by default to
+ ;; be outside 'byline propt.
+ (when (and avatar ; used by `mastodon-profile--format-user'
+ mastodon-tl--show-avatars
+ mastodon-tl--display-media-p
+ (mastodon-tl--image-trans-check))
+ (mastodon-media--get-avatar-rendering
+ (map-nested-elt data '(account avatar))))
+ (if (not base)
+ ;; boost symbol:
+ (concat (mastodon-tl--symbol 'boost)
+ " "
+ ;; username as button:
+ (mastodon-tl--byline-handle
+ data domain
+ ;; display uname not handle (for boosts):
+ uname 'mastodon-display-name-face))
+ ;; normal combo author byline:
+ (mastodon-tl--byline-uname-+-handle data domain)))))
+
+(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-item' 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:
+ (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
+ (fol-req-p (let ((type (alist-get 'type toot-to-count)))
+ (or (string= type "follow")
+ (string= type "follow_request")))))
+ (unless fol-req-p
+ (let* ((media-types (mastodon-tl--get-media-types toot))
+ (format-media (when media-types
+ (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))
+ " | C-RET to view with mpv")))
+ (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)))
+ (mastodon-tl--map-alist 'type attachments)))
+
+(defun mastodon-tl--get-attachments-for-byline (toot)
+ "Return a list of attachment URLs and types for TOOT.
+The result is added as an attachments property to author-byline."
+ (let ((media (mastodon-tl--field 'media_attachments toot)))
+ (mapcar (lambda (attachment)
+ (let-alist attachment
+ (list :id .id
+ :type .type
+ ;; fallback for notifications:
+ :url (or .remote_url .url))))
+ media)))
+
+(defun mastodon-tl--acc-by-id (id)
+ "Return account JSON for ID."
+ (let* ((endpoint (format "accounts/%s" id))
+ (url (mastodon-http--api endpoint)))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl--top-byline (toot)
+ "Format a boost or reply top (action) byline for TOOT.
+If it is a self-reply, return \\='continued thread'.
+If it is a non-self-reply, return \\='in reply to $username'.
+If it is a boost, return \\='$username boosted'."
+ (let ((reblog (alist-get 'reblog toot))
+ (reply-acc-id (alist-get 'in_reply_to_account_id toot)))
+ (cond
+ (reblog
+ (concat (mastodon-tl--byline-author toot) " "
+ (propertize "boosted" 'face 'mastodon-boosted-face) "\n"))
+ (reply-acc-id
+ (unless (mastodon-tl--buffer-type-eq 'thread)
+ (if (equal reply-acc-id (map-nested-elt toot '(account id)))
+ (concat (mastodon-tl--symbol 'reply) " "
+ (mastodon-tl--buttonify-link
+ "continued thread\n"
+ 'face 'mastodon-boosted-face
+ 'continued-thread t
+ 'help-echo "Browse thread"))
+ (let* ((acc (mastodon-tl--acc-by-id reply-acc-id))
+ (name (or (alist-get 'display_name acc)
+ (alist-get 'username acc))))
+ (concat (mastodon-tl--symbol 'reply)
+ (mastodon-tl--buttonify-link
+ " in reply to "
+ 'face 'mastodon-boosted-face
+ 'continued-thread t
+ 'help-echo "Browse thread")
+ (propertize name
+ 'face 'mastodon-display-name-face)
+ "\n")))))
+ (t ""))))
+
+(defun mastodon-tl-continued-thread-load ()
+ "Load thread based on prop item-id.
+Used to load self-reply threads by clicking on top-byline's \"continued
+thead\" text."
+ (interactive)
+ (let ((id (mastodon-tl--property 'item-id)))
+ (mastodon-tl--thread-do id)))
+
+(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 ((string= letter "F")
+ "favourited")
+ ((string= letter "B")
+ "boosted")
+ ((string= 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."
+ ;; FIXME: this is often nil
+ help-string)))))
+
+(defun mastodon-tl--image-trans-check ()
+ "Call `image-transforms-p', or `image-type-available-p' imagemagick."
+ (if (version< emacs-version "27.1")
+ (image-type-available-p 'imagemagick)
+ (image-transforms-p)))
+
+(defun mastodon-tl--byline (toot &optional detailed-p
+ domain base-toot group ts)
+ "Generate (bottom) byline for TOOT.
+DETAILED-P means display more detailed info. For now
+this just means displaying toot client.
+When DOMAIN, force inclusion of user's domain in their handle.
+BASE-TOOT is JSON for the base toot, if any.
+GROUP is the notification group if any.
+ACCOUNT is the notification account if any.
+TS is a timestamp from the server, if any."
+ (let* ((type (alist-get 'type (or group toot)))
+ (created-time
+ (or ts ;; mentions, statuses, folls/foll-reqs
+ ;; bosts, faves, edits, polls in notifs view use base item
+ ;; timestamp:
+ (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 (when created-time (date-to-time created-time)))
+ ;; non-grouped notifs now need to pull the following data from
+ ;; base toot:
+ (base-maybe (or base-toot ;; show edits for notifs
+ (mastodon-tl--toot-or-base toot))) ;; for boosts
+ (faved (eq t (mastodon-tl--field 'favourited base-maybe)))
+ (boosted (eq t (mastodon-tl--field 'reblogged base-maybe)))
+ (bookmarked (eq t (mastodon-tl--field 'bookmarked base-maybe)))
+ (visibility (mastodon-tl--field 'visibility base-maybe))
+ (account (alist-get 'account base-maybe))
+ (botp (eq t (map-nested-elt base-maybe '(account bot))))
+ (avatar-url (alist-get 'avatar account))
+ (edited-time (alist-get 'edited_at base-maybe))
+ (edited-parsed (when edited-time (date-to-time edited-time))))
+ (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
+ ;; ensures that `mastodon-tl-goto-next-item' puts point on
+ ;; author-byline, not before the (F) or (B) marker. Not propertizing like
+ ;; 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
+ (mastodon-tl--symbol 'boost)))
+ (when faved
+ (mastodon-tl--format-faved-or-boosted-byline
+ (mastodon-tl--symbol 'favourite)))
+ (when bookmarked
+ (mastodon-tl--format-faved-or-boosted-byline
+ (mastodon-tl--symbol 'bookmark)))
+ (when botp
+ (concat (mastodon-tl--symbol 'bot) " ")))
+ ;; we remove avatars from the byline also, so that they also do not
+ ;; mess with `mastodon-tl-goto-next-item':
+ (when (and mastodon-tl--show-avatars
+ mastodon-tl--display-media-p
+ (mastodon-tl--image-trans-check))
+ (mastodon-media--get-avatar-rendering avatar-url))
+ (propertize
+ (concat
+ ;; NB: action-byline (boost) is now added in insert-status, so no
+ ;; longer part of the byline.
+ ;; (base) author byline:
+ ;; we use base-toot if poss for fave/boost notifs that need to show
+ ;; base item in author byline
+ (mastodon-tl--byline-author (or base-toot toot)
+ nil domain :base)
+ ;; visibility:
+ (cond ((string= visibility "direct")
+ (propertize (concat " " (mastodon-tl--symbol 'direct))
+ 'help-echo visibility))
+ ((string= visibility "private")
+ (propertize (concat " " (mastodon-tl--symbol 'private))
+ 'help-echo visibility)))
+ " "
+ ;; timestamp:
+ (let ((ts (format-time-string
+ mastodon-toot-timestamp-format parsed-time)))
+ (propertize ts
+ 'timestamp parsed-time
+ 'display
+ (if mastodon-tl--enable-relative-timestamps
+ (mastodon-tl--relative-time-description parsed-time)
+ parsed-time)
+ 'help-echo ts))
+ ;; detailed:
+ (when detailed-p
+ (let* ((app-name (map-nested-elt toot '(application name)))
+ (app-url (map-nested-elt toot '(application website))))
+ (when app-name
+ (concat
+ (propertize " via " 'face 'default)
+ (propertize app-name
+ 'face 'mastodon-display-name-face
+ 'follow-link t
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'shr-url
+ 'shr-url app-url
+ 'help-echo app-url
+ 'keymap mastodon-tl--shr-map-replacement)))))
+ ;; edited:
+ (when edited-time
+ (concat
+ " "
+ (mastodon-tl--symbol 'edited)
+ " "
+ (propertize
+ (format-time-string mastodon-toot-timestamp-format
+ edited-parsed)
+ 'face 'mastodon-toot-docs-face
+ 'timestamp edited-parsed
+ 'display (if mastodon-tl--enable-relative-timestamps
+ (mastodon-tl--relative-time-description edited-parsed)
+ edited-parsed))))
+ (propertize (concat "\n " mastodon-tl--horiz-bar)
+ 'face 'default)
+ ;; stats:
+ (when (and mastodon-tl--show-stats
+ (not (member type '("follow" "follow_request"))))
+ (mastodon-tl--toot-stats toot))
+ "\n")
+ 'favourited-p faved
+ 'boosted-p boosted
+ 'bookmarked-p bookmarked
+ ;; enable playing of videos when point is on byline:
+ 'attachments (mastodon-tl--get-attachments-for-byline toot)
+ 'edited edited-time
+ 'edit-history (when edited-time
+ (mastodon-toot--get-toot-edits
+ (alist-get 'id base-maybe)))
+ 'byline t))))
+
+\f
+;;; TIMESTAMPS
+
+(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* ((time-difference (time-subtract current-time timestamp))
+ (seconds-difference (float-time time-difference))
+ (tmp (mastodon-tl--human-duration (max 0 seconds-difference))))
+ ;; revert to old just now style for < 1 min
+ (cons (concat (car tmp) (if (string= "just now" (car tmp)) "" " ago"))
+ (time-add current-time (cdr tmp)))))
+
+(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)))
+
+\f
+;;; RENDERING HTML, LINKS, HASHTAGS, HANDLES
+
+(defun mastodon-tl--render-text (string &optional toot)
+ "Return a propertized text rendering the given HTML string STRING.
+The contents comes from the given TOOT which is used in parsing
+links in the text. If TOOT is nil no parsing occurs."
+ (when string ; handle rare empty notif server bug
+ (with-temp-buffer
+ (insert string)
+ (let ((shr-use-fonts mastodon-tl--enable-proportional-fonts)
+ (shr-width (when mastodon-tl--enable-proportional-fonts
+ (if mastodon-tl--no-fill-on-render
+ 0
+ (- (window-width) 3))))
+ (cat (get 'mastodon-tl-link 'button-category-symbol)))
+ (shr-render-region (point-min) (point-max))
+ (alter-text-property
+ (point-min) (point-max) 'category
+ (lambda (type) (when type cat))))
+ ;; Make all links a tab stop recognized by our own logic, make
+ ;; things point to our own logic (e.g. hashtags), and update keymaps
+ ;; where needed:
+ (when toot
+ (let (region)
+ (while (setq region (mastodon-tl--find-property-range
+ 'shr-url (or (cdr region) (point-min))))
+ (mastodon-tl--process-link toot
+ (car region) (cdr region)
+ (get-text-property (car region) 'shr-url))
+ (when (proper-list-p toot) ;; not on profile fields cons cells
+ ;; render card author maybe:
+ (let* ((card-url (map-nested-elt toot '(card url)))
+ (authors (map-nested-elt toot '(card authors)))
+ (url (buffer-substring (car region) (cdr region)))
+ (url-no-query (car (split-string url "?"))))
+ (when (and (string= url-no-query card-url)
+ ;; only if we have an account's data:
+ (alist-get 'account (car authors)))
+ (goto-char (point-max))
+ (mastodon-tl--insert-card-authors authors)))))))
+ (buffer-string))))
+
+(defun mastodon-tl--insert-card-authors (authors)
+ "Insert a string of card AUTHORS."
+ (let ((authors-str (format "Author%s: "
+ (if (< 1 (length authors)) "s" ""))))
+ (insert
+ (concat
+ "\n(" authors-str
+ (mapconcat #'mastodon-tl--format-card-author authors "\n")
+ ")\n"))))
+
+(defun mastodon-tl--format-card-author (data)
+ "Render card author DATA."
+ (when-let* ((account (alist-get 'account data))) ;.account
+ (let-alist account ;.account
+ ;; FIXME: replace with refactored handle render fun
+ ;; in byline refactor branch:
+ (concat
+ (propertize (mastodon-tl--unicode-wrap (or .display_name .username))
+ 'face 'mastodon-display-name-face
+ 'item-type 'user
+ 'item-id .id)
+ " "
+ (propertize (concat "@" .acct)
+ 'face 'mastodon-handle-face
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'user-handle
+ 'keymap mastodon-tl--link-keymap
+ 'mastodon-handle (concat "@" .acct)
+ 'help-echo (concat "Browse user profile of @" .acct))))))
+
+(defun mastodon-tl--process-link (toot start end url)
+ "Process link URL in TOOT as hashtag, userhandle, or normal link.
+START and END are the boundaries of the link in the toot."
+ (let* (mastodon-tab-stop-type
+ keymap
+ (help-echo (get-text-property start 'help-echo))
+ extra-properties
+ ;; handle calling this on non-toots, e.g. for profiles:
+ (toot-url (when (proper-list-p toot)
+ (mastodon-tl--field 'url toot)))
+ (toot-url (when toot-url (url-generic-parse-url toot-url)))
+ (toot-instance-url (if toot-url
+ (concat (url-type toot-url) "://"
+ (url-host toot-url))
+ mastodon-instance-url))
+ (link-str (buffer-substring-no-properties start end))
+ (maybe-hashtag (mastodon-tl--hashtag-from-url
+ url toot-instance-url))
+ (maybe-userhandle
+ (if (proper-list-p toot) ; fails for profile buffers?
+ (or (mastodon-tl--userhandle-from-mentions toot link-str)
+ (mastodon-tl--userhandle-from-url url link-str))
+ (mastodon-tl--userhandle-from-url url link-str))))
+ (cond (maybe-hashtag
+ (setq mastodon-tab-stop-type 'hashtag
+ keymap mastodon-tl--link-keymap
+ help-echo (concat "Browse tag #" maybe-hashtag)
+ extra-properties (list 'mastodon-tag maybe-hashtag)))
+ (maybe-userhandle ;; fails on mentions in profile notes:
+ (let ((maybe-userid (when (proper-list-p toot)
+ (mastodon-tl--extract-userid-toot
+ toot link-str))))
+ (setq mastodon-tab-stop-type 'user-handle
+ keymap mastodon-tl--link-keymap
+ help-echo (concat "Browse user profile of " maybe-userhandle)
+ extra-properties (append
+ (list 'mastodon-handle maybe-userhandle)
+ (when maybe-userid
+ (list 'account-id maybe-userid))))))
+ (t ;; Anything else (leave it as a url handled by shr.el):
+ (setq keymap (if (eq shr-map (get-text-property start 'keymap))
+ mastodon-tl--shr-map-replacement
+ mastodon-tl--shr-image-map-replacement)
+ mastodon-tab-stop-type 'shr-url)))
+ (add-text-properties start end
+ (append
+ (list 'mastodon-tab-stop mastodon-tab-stop-type
+ 'keymap keymap
+ 'help-echo help-echo)
+ extra-properties))))
+
+(defun mastodon-tl--userhandle-from-mentions (toot link)
+ "Extract a user handle from mentions in json TOOT.
+LINK is maybe the `@handle' to search for."
+ (mastodon-tl--el-from-mentions 'acct toot link))
+
+(defun mastodon-tl--extract-userid-toot (toot link)
+ "Extract a user id for an ACCT from mentions in a TOOT.
+LINK is maybe the `@handle' to search for."
+ (mastodon-tl--el-from-mentions 'id toot link))
+
+(defun mastodon-tl--el-from-mentions (el toot link)
+ "Extract element EL from TOOT mentions that matches LINK.
+LINK should be a simple handle string with no domain, i.e. \"@user\".
+Return nil if no matching element."
+ (let ((mentions (alist-get 'mentions toot)))
+ (when mentions
+ (let* ((mention (pop mentions))
+ (name (substring-no-properties link 1 (length link))) ; cull @
+ return)
+ (while mention
+ (when (string= name (alist-get 'username mention))
+ (setq return (alist-get el mention)))
+ (setq mention (pop mentions)))
+ return))))
+
+(defun mastodon-tl--userhandle-from-url (url &optional buffer-text)
+ "Return the user hande the URL points to or nil if it is not a profile link.
+BUFFER-TEXT is the text covered by the link with URL, for a user profile
+this should be of the form <at-sign><user id>, e.g. \"@Gargon\".
+This is called on all post URLs, so needs to handle non profile URLs
+gracefully."
+ (let* ((parsed-url (url-generic-parse-url url))
+ (host (url-host parsed-url))
+ (local-p (string=
+ (url-host (url-generic-parse-url mastodon-instance-url))
+ host))
+ (path-raw (url-filename parsed-url)))
+ (unless (string-empty-p path-raw)
+ (let ((path (substring path-raw 1))) ;; remove "/" prefix
+ (if (not buffer-text)
+ (when (string-prefix-p "@" path)
+ (if local-p path (concat "@" host)))
+ (when (and (string= "@" (substring buffer-text 0 1))
+ ;; don't error on domain only url (rare):
+ (string= (downcase buffer-text)
+ (downcase path)))
+ (if local-p
+ buffer-text ; no instance suffix for local mention
+ (concat buffer-text "@" host))))))))
+
+(defun mastodon-tl--hashtag-from-url (url instance-url)
+ "Return the hashtag that URL points to or nil if URL is not a tag link.
+INSTANCE-URL is the url of the instance for the toot that the link
+came from (tag links always point to a page on the instance publishing
+the toot)."
+ ;; TODO: do we rly need to check it against instance-url?
+ ;; test suggests we might
+ (let* ((instance-host (url-host
+ (url-generic-parse-url instance-url)))
+ (parsed (url-generic-parse-url url))
+ (path (url-filename parsed)))
+ (when (string= instance-host (url-host parsed))
+ (cond ((string-prefix-p "/tag" path) ;; "/tag/" or "/tags/"
+ (let ((split (split-string path "/")))
+ (nth 2 split)))
+ ((string-prefix-p "?t=" path) ;; snac tag
+ (let ((split (split-string path "=")))
+ (nth 1 split)))))))
+
+(defun mastodon-tl--base-tags (tags body-tags)
+ "Return a string of all tags not in BODY-TAGS, linkified.
+TAGS is a list of tag alists, from a post's JSON."
+ (when (mastodon-tl--base-tags-print-p tags body-tags)
+ (concat
+ "\n"
+ (cl-loop for tag in tags
+ concat (concat (mastodon-tl--render-base-tag tag body-tags)
+ " ")))))
+
+(defun mastodon-tl--base-tags-print-p (tags body-tags)
+ "Non-nil if we need to print base tags.
+We need to do so if TAGS contains any elements not in BODY-TAGS."
+ (cl-remove-if
+ (lambda (tag)
+ ;; downcase name string (body strings are downcased):
+ (member (downcase (alist-get 'name tag)) body-tags))
+ tags))
+
+(defun mastodon-tl--render-base-tag (tag body-tags)
+ "Return TAG as a linkified string, provided it is not in BODY-TAGS."
+ (let ((name (alist-get 'name tag)))
+ (unless (member (downcase name) body-tags)
+ (mastodon-tl--buttonify-link
+ (concat "#" name)
+ 'mastodon-tab-stop 'hashtag
+ 'mastodon-tag name
+ 'mouse-face '(highlight)
+ 'keymap mastodon-tl--link-keymap
+ 'face '(shr-text shr-link)
+ 'follow-link t
+ 'shr-tab-stop t
+ 'shr-url (alist-get 'url tag)
+ 'help-echo (concat "Browse tag #" name)))))
+
+\f
+;;; HYPERLINKS
+
+(define-button-type 'mastodon-tl-link
+ 'action #'mastodon-tl--push-button
+ 'keymap mastodon-tl--link-keymap
+ 'mouse-face 'highlight)
+
+(defun mastodon-tl--push-button (button)
+ "Do the appropriate action for BUTTON."
+ (mastodon-tl-do-link-action-at-point (button-start button)))
+
+(defun mastodon-tl--buttonify-link (string &rest properties)
+ "Make STRING a `mastodon-tl-link' type button.
+PROPERTIES are additional properties to attach to string."
+ (apply #'propertize string
+ 'button t
+ 'category (get 'mastodon-tl-link 'button-category-symbol)
+ properties))
+
+(defun mastodon-tl--make-link (string link-type)
+ "Return a propertized version of STRING that will act like link.
+LINK-TYPE is the type of link to produce."
+ (let ((help-text (cond ((eq link-type 'content-warning)
+ "Toggle hidden text")
+ ((or (eq link-type 'read-more)
+ (eq link-type 'read-less))
+ "Toggle full post")
+ (t
+ (error "Unknown link type %s" link-type)))))
+ (mastodon-tl--buttonify-link string
+ 'mastodon-tab-stop link-type
+ 'help-echo help-text)))
+
+(defun mastodon-tl-do-link-action-at-point (pos)
+ "Do the action of the link at POS.
+Used for hitting RET on a given link."
+ (interactive "d")
+ (let ((link-type (get-text-property pos 'mastodon-tab-stop))
+ (cont-thread (mastodon-tl--property 'continued-thread :nomove))
+ (quote-toot (mastodon-tl--property 'quote-url :nomove)))
+ (cond (cont-thread
+ (mastodon-tl-continued-thread-load))
+ (quote-toot
+ (let ((url (mastodon-tl--property 'quote-url :nomove)))
+ (mastodon-url-lookup url)))
+ ((eq link-type 'content-warning)
+ (mastodon-tl--toggle-spoiler-text pos))
+ ((eq link-type 'hashtag)
+ (mastodon-tl--show-tag-timeline
+ nil (get-text-property pos 'mastodon-tag)))
+ ;; 'account / 'account-id is not set for mentions, only bylines
+ ((eq link-type 'user-handle)
+ (let ((account-json (get-text-property pos 'account))
+ (account-id (get-text-property pos 'account-id)))
+ (cond
+ (account-json
+ (mastodon-profile--make-author-buffer account-json))
+ (account-id
+ (mastodon-profile--make-author-buffer
+ (mastodon-profile--account-from-id account-id)))
+ (t
+ (let ((account (mastodon-profile--search-account-by-handle
+ (get-text-property pos 'mastodon-handle))))
+ ;; never call make-author-buffer on nil account:
+ (cond (account
+ (mastodon-profile--make-author-buffer account))
+ ;; optional webfinger lookup:
+ ((y-or-n-p
+ "Search for account returned nothing. Perform URL lookup?")
+ (mastodon-url-lookup (get-text-property pos 'shr-url)))
+ (t
+ (error "Unable to find account"))))))))
+ ((eq link-type 'shr-url)
+ (mastodon-url-lookup (get-text-property pos 'shr-url)))
+ ((eq link-type 'read-more)
+ (mastodon-tl-unfold-post))
+ ((eq link-type 'read-less)
+ (mastodon-tl-fold-post))
+ (t
+ (error "Unknown link type %s" link-type)))))
+
+(defun mastodon-tl-do-link-action (event)
+ "Do the action of the link at point.
+Used for a mouse-click EVENT on a link."
+ (interactive "@e")
+ (mastodon-tl-do-link-action-at-point (posn-point (event-end event))))
+
+\f
+;;; 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
+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-region (mastodon-tl--find-property-range
+ 'mastodon-content-warning-body position nil))
+ (new-state (not (get-text-property (car spoiler-region)
+ 'invisible))))
+ (if (not spoiler-region)
+ (user-error "No spoiler text here")
+ (add-text-properties (car spoiler-region) (cdr spoiler-region)
+ (list 'invisible new-state))
+ new-state))) ;; return what we set invisibility to
+
+(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
+ 'item-json (point))
+ (mastodon-tl--find-property-range
+ 'item-json (point) t)))
+ (spoiler-range (when toot-range
+ (mastodon-tl--find-property-range
+ 'mastodon-content-warning-body
+ (car toot-range)))))
+ (cond ((null toot-range)
+ (user-error "No toot here"))
+ ((or (null spoiler-range)
+ (> (car spoiler-range) (cdr toot-range)))
+ (user-error "No content warning text here"))
+ (t
+ (mastodon-tl--toggle-spoiler-text (car spoiler-range))))))
+
+(defun mastodon-tl-toggle-spoiler-in-thread ()
+ "Toggler content warning for all posts in current thread."
+ (interactive)
+ (let ((thread-p (eq (mastodon-tl--buffer-property 'update-function)
+ 'mastodon-tl--thread-do)))
+ (if (not thread-p)
+ (user-error "Not in a thread")
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (string= "No more items" ; improve this hack test!
+ (mastodon-tl-goto-next-item :no-refresh)))
+ (let* ((json (mastodon-tl--property 'item-json :no-move))
+ (cw (alist-get 'spoiler_text json)))
+ (when (not (string= "" cw))
+ (let ((new-state
+ (pcase
+ (mastodon-tl-toggle-spoiler-text-in-toot)
+ ('t 'folded)
+ ('nil 'unfolded))))
+ (plist-put mastodon-tl--buffer-spec
+ 'thread-unfolded new-state)))))))))
+
+(defun mastodon-tl--spoiler (toot &optional filter)
+ "Render TOOT with spoiler message.
+This assumes TOOT is a toot with a spoiler message.
+The main body gets hidden and only the spoiler text and the
+content warning message are displayed. The content warning
+message is a link which unhides/hides the main body.
+FILTER is a string to use as a filter warning spoiler instead."
+ (let* ((spoiler (mastodon-tl--field 'spoiler_text toot))
+ (string (mastodon-tl--set-face
+ (mastodon-tl--clean-tabs-and-nl
+ (mastodon-tl--render-text spoiler toot))
+ 'default))
+ (message (concat " " mastodon-tl--horiz-bar "\n "
+ (mastodon-tl--make-link
+ (if filter
+ (concat "Filtered: " filter)
+ (concat "CW: " string))
+ 'content-warning)
+ "\n "
+ mastodon-tl--horiz-bar "\n"))
+ (cw (mastodon-tl--set-face message 'mastodon-cw-face)))
+ (concat
+ cw
+ (propertize
+ (mastodon-tl--content toot)
+ 'invisible (mastodon-tl--spoiler-invisible-maybe filter)
+ 'mastodon-content-warning-body t))))
+
+(defun mastodon-tl--spoiler-invisible-maybe (&optional filter)
+ "Set the invisible property for a post with a spoiler.
+Also used to set invisibility for quoted posts.
+We respect `mastodon-tl--expand-content-warnings'.
+If it is server, we check the user's preference.
+FILTER means we go invisible."
+ (or filter ;; filters = invis
+ (let ((cust mastodon-tl--expand-content-warnings))
+ (if (not (eq 'server cust))
+ (not cust) ;; opp to setting
+ ;; respect server setting:
+ ;; If something goes wrong reading prefs,
+ ;; just return t so CWs fold by default.
+ (condition-case nil
+ (eq :json-false
+ (mastodon-profile--get-preferences-pref
+ 'reading:expand:spoilers))
+ (error t))))))
+
+\f
+;;; MEDIA
+
+(defun mastodon-tl--media (toot)
+ "Retrieve a media attachment link for TOOT if one exists.
+Else return an empty string."
+ (let* ((attachments (mastodon-tl--field 'media_attachments toot))
+ (sensitive (mastodon-tl--field 'sensitive toot))
+ (media-string (mapconcat
+ (lambda (x)
+ (mastodon-tl--media-attachment x sensitive))
+ attachments "")))
+ (if (not (and mastodon-tl--display-media-p
+ (string-empty-p media-string)))
+ (concat "\n" media-string)
+ "")))
+
+(defun mastodon-tl--media-attachment (attachment sensitive)
+ "Return a propertized string for ATTACHMENT.
+SENSITIVE is a flag from the item's JSON data."
+ (let-alist attachment
+ (let ((display-str
+ (concat "Media:: "
+ (if (and mastodon-tl--display-caption-not-url-when-no-media
+ .description)
+ .description
+ .preview_url)))
+ (remote-url (or .remote_url .url)))
+ (if (and mastodon-tl--display-media-p
+ ;; if in notifs, also check notifs images custom:
+ (if (or (mastodon-tl--buffer-type-eq 'notifications)
+ (mastodon-tl--buffer-type-eq 'mentions))
+ mastodon-images-in-notifs
+ t))
+ (mastodon-media--get-media-link-rendering ; placeholder: "[img]"
+ .preview_url remote-url ; for shr-browse-url
+ .type .description sensitive)
+ ;; return URL/caption:
+ (concat (mastodon-tl--propertize-img-str-or-url
+ (concat "Media:: " .preview_url) ; string
+ .preview_url remote-url .type .description
+ display-str 'shr-link .description sensitive)
+ "\n")))))
+
+(defun mastodon-tl--propertize-img-str-or-url
+ (str media-url full-remote-url type help-echo
+ &optional display face caption sensitive)
+ "Propertize an media placeholder string \"[img]\" or media URL.
+STR is the string to propertize, MEDIA-URL is the preview link,
+FULL-REMOTE-URL is the link to the full resolution image on the
+server, TYPE is the media type.
+HELP-ECHO, DISPLAY, and FACE are the text properties to add.
+CAPTION is the image caption, added as a text property.
+SENSITIVE is a flag from the item's JSON data."
+ (propertize str
+ 'media-url media-url
+ 'media-state (when (string= str "[img]") 'needs-loading)
+ 'media-type 'media-link
+ 'mastodon-media-type type
+ 'display display
+ 'face face
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'image ; for do-link-action-at-point
+ 'image-url (or full-remote-url media-url) ; for shr-browse-image
+ 'keymap mastodon-tl--shr-image-map-replacement
+ 'image-description caption
+ 'shr-alt caption ; for shr-show-alt-text
+ 'sensitive sensitive
+ '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"))))
+
+;;; FULL IMAGE VIEW
+
+(define-derived-mode mastodon-image-mode image-mode
+ "mastodon-image"
+ :group 'mastodon
+ ;; Disable `pixel-scroll-precision-mode' locally because it doesn't
+ ;; work nicely with `mastodon-image-mode':
+ ;; thanks Tusar for this fix:
+ (when (bound-and-true-p pixel-scroll-precision-mode)
+ (setq-local pixel-scroll-precision-mode nil)))
+
+;; patch `shr-browse-image' to accept url arg:
+(defun mastodon-tl-shr-browse-image (&optional arg)
+ "Browse the image under point.
+With prefix argument ARG, copy the URL of the image instead.
+If URL is a string, use it rather than the image-url property at point."
+ (interactive "P")
+ (let ((prop (get-text-property (point) 'image-url)))
+ (if current-prefix-arg
+ (if (not prop)
+ (user-error "No image at point?")
+ (with-temp-buffer
+ (insert prop)
+ (copy-region-as-kill (point-min) (point-max))
+ (message "Copied %s" prop)))
+ (let ((url (or arg prop)))
+ (if (not url)
+ (user-error "No URL here?")
+ (message "Browsing %s..." url)
+ (browse-url url))))))
+
+(defun mastodon-tl--view-image-url (url attachments)
+ "View image URL. Set ATTACHMENTS metadata in image buffer."
+ (if (not url)
+ (user-error "No url found")
+ (if (not mastodon-tl--load-full-sized-images-in-emacs)
+ (mastodon-tl-shr-browse-image url)
+ (mastodon-media--image-or-cached
+ url #'mastodon-media--process-full-sized-image-response
+ `(nil ,url ,attachments ,(buffer-name))))))
+
+(defun mastodon-tl-view-full-image-at-point ()
+ "Browse full-sized version of image at point in a new window."
+ (interactive)
+ (if (not (eq (mastodon-tl--property 'mastodon-tab-stop) 'image))
+ (user-error "No image at point?")
+ (let* ((url (mastodon-tl--property 'image-url))
+ (attachments (mastodon-tl--property 'attachments)))
+ (mastodon-tl--view-image-url url attachments))))
+
+(defun mastodon-tl-view-first-full-image ()
+ "From item byline, fetch load its first full image."
+ (interactive)
+ (let* ((attachments (mastodon-tl--property 'attachments))
+ (url (plist-get (car attachments) :url)))
+ (if (not attachments)
+ (user-error "Toot has no attachments")
+ (mastodon-tl--view-image-url url attachments))))
+
+(defun mastodon-tl--get-next-image-url ()
+ "Return the url for the next image to load.
+Cycles through values in `mastodon-media--attachments'."
+ (let* ((url (car mastodon-media--attachments))
+ ;; match url against our plists:
+ (current (mastodon-tl--current-image-url url)))
+ ;; fetch from next item in current or use first item if current has
+ ;; only 1 item:
+ (plist-get (if (= 1 (length current))
+ (cadr mastodon-media--attachments)
+ (cadr current))
+ :url)))
+
+(defun mastodon-tl--current-image-url (url)
+ "Try to fetch URL from `mastodon-media--attachments'.
+The return value is that of `cl-member-if', ie if a match is found, it
+returns the match and the list of which it is the car."
+ (cl-member-if
+ (lambda (attachment)
+ (equal url (plist-get attachment :url)))
+ (cdr mastodon-media--attachments)))
+
+(defun mastodon-tl--get-prev-image-url ()
+ "Return the URL of the previous item in `mastodon-media--attachments'."
+ (let* ((url (car mastodon-media--attachments))
+ (current (mastodon-tl--current-image-url url)))
+ (plist-get (nth (1- (length current))
+ (cdr mastodon-media--attachments))
+ :url)))
+
+(defun mastodon-tl-next-full-image ()
+ "From full image view buffer, load the toot's next image."
+ (interactive)
+ (let* ((next-url (mastodon-tl--get-next-image-url)))
+ (mastodon-tl--view-image-url next-url
+ (cdr mastodon-media--attachments))))
+
+(defun mastodon-tl-prev-full-image ()
+ "From full image view buffer, load the toot's prev image."
+ (interactive)
+ (let* ((prev-url (mastodon-tl--get-prev-image-url)))
+ (mastodon-tl--view-image-url prev-url
+ (cdr mastodon-media--attachments))))
+
+(defun mastodon-tl-toggle-sensitive-image ()
+ "Toggle dislay of sensitive image at point."
+ (interactive)
+ (if (not (eq t (mastodon-tl--property 'sensitive)))
+ (user-error "No sensitive media at point?")
+ (let ((data (mastodon-tl--property 'image-data :no-move))
+ (inhibit-read-only t)
+ (end (next-single-property-change (point) 'sensitive-state)))
+ (add-text-properties
+ (point) end
+ (if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move))
+ ;; display:
+ `( display ,data
+ sensitive-state showing)
+ ;; hide:
+ `( sensitive-state hidden
+ display
+ ,(create-image
+ mastodon-media--sensitive-image-data nil t)))))))
+
+\f
+;; POLLS
+
+(defun mastodon-tl--format-poll-option (option counter length)
+ "Format poll OPTION. COUNTER is a counter.
+LENGTH is of the longest option, for formatting."
+ (format "%s: %s%s%s\n"
+ counter
+ (propertize (alist-get 'title option)
+ 'face 'success)
+ (make-string (1+ (- length
+ (length (alist-get 'title option))))
+ ?\ )
+ ;; TODO: disambiguate no votes from hidden votes
+ (format "[%s votes]" (or (alist-get 'votes_count option)
+ "0"))))
+
+(defun mastodon-tl--format-poll (poll)
+ "From json poll data POLL, return a display string."
+ (let-alist poll
+ (let* ((options (mastodon-tl--map-alist 'title .options))
+ (longest (car (sort (mapcar #'length options ) #'>)))
+ (counter 0))
+ (concat "\n"
+ (mastodon-tl--symbol 'poll)
+ "\n\n"
+ (mapconcat (lambda (option)
+ (setq counter (1+ counter))
+ (mastodon-tl--format-poll-option
+ option counter longest))
+ .options
+ "\n")
+ "\n"
+ (propertize
+ (cond (.voters_count ; sometimes it is nil
+ (format "%s %s | " .voters_count
+ (if (= .voters_count 1) "person" "people")))
+ (.vote_count
+ (format "%s votes | " .vote_count))
+ (t ""))
+ 'face 'mastodon-toot-docs-face)
+ (let ((str (if (eq .expired :json-false)
+ (if (eq .expires_at nil)
+ ""
+ (mastodon-tl--format-poll-expiry .expires_at))
+ "Poll expired.")))
+ (propertize str 'face 'mastodon-toot-docs-face))
+ "\n"))))
+
+(defconst mastodon-tl--time-units
+ '("sec" 60.0 ;; Use a float to convert `n' to float.
+ "min" 60
+ "hour" 24
+ "day" 7
+ "week" 4.345
+ "month" 12
+ "year"))
+
+(defun mastodon-tl--format-poll-expiry (timestamp)
+ "Convert poll expiry TIMESTAMP into a descriptive string.
+TIMESTAMP is from the expires_at field of a poll's JSON data, and
+is in ISO 8601 Datetime format."
+ (let* ((ts (encode-time (parse-time-string timestamp)))
+ (seconds (time-to-seconds (time-subtract ts nil))))
+ ;; FIXME: Use the `cdr' to update poll expiry times?
+ (concat (car (mastodon-tl--human-duration (max 0 seconds))) " left")))
+
+(defun mastodon-tl--human-duration (seconds &optional resolution)
+ "Return a string describing SECONDS in a more human-friendly way.
+The return format is (STRING . RES) where RES is the resolution of
+this string, in seconds.
+RESOLUTION is the finest resolution, in seconds, to use for the
+second part of the output (defaults to 60, so that seconds are only
+displayed when the duration is smaller than a minute)."
+ (cl-assert (>= seconds 0))
+ (unless resolution (setq resolution 60))
+ (let* ((units mastodon-tl--time-units)
+ (n1 seconds) (unit1 (pop units)) (res1 1)
+ n2 unit2 res2
+ next)
+ (while (and units (> (truncate (setq next (/ n1 (car units)))) 0))
+ (setq unit2 unit1)
+ (setq res2 res1)
+ (setq n2 (- n1 (* (car units) (truncate n1 (car units)))))
+ (setq n1 next)
+ (setq res1 (truncate (* res1 (car units))))
+ (pop units)
+ (setq unit1 (pop units)))
+ (setq n1 (truncate n1))
+ (if n2 (setq n2 (truncate n2)))
+ (cond
+ ((null n2)
+ ;; revert to old just now style for < 1 min:
+ (cons "just now" 60))
+ ;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
+ ;; (max resolution res1)))
+ ((< (* res2 n2) resolution)
+ (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
+ (max resolution res2)))
+ ((< res2 resolution)
+ (let ((n2 (/ (* resolution (/ (* n2 res2) resolution)) res2)))
+ (cons (format "%d %s%s, %d %s%s"
+ n1 unit1 (if (> n1 1) "s" "")
+ n2 unit2 (if (> n2 1) "s" ""))
+ resolution)))
+ (t
+ (cons (format "%d %s%s, %d %s%s"
+ n1 unit1 (if (> n1 1) "s" "")
+ n2 unit2 (if (> n2 1) "s" ""))
+ (max res2 resolution))))))
+
+(defun mastodon-tl--format-read-poll-option (options)
+ "Format poll OPTIONS for `completing-read'.
+OPTIONS is an alist."
+ ;; we display option number and the option title
+ ;; but also store both as a cons cell as the cdr, as we need it later
+ (cl-loop for cell in options
+ collect (cons (format "%s | %s" (car cell) (cdr cell))
+ cell)))
+
+(defun mastodon-tl--read-poll-option ()
+ "Read a poll option to vote on a poll."
+ (let* ((toot (mastodon-tl--property 'item-json))
+ (poll (mastodon-tl--field 'poll toot)))
+ (if (null poll)
+ (user-error "No poll here")
+ (let* ((options (mastodon-tl--field 'options poll))
+ (titles (mastodon-tl--map-alist 'title options))
+ (number-seq (number-sequence 1 (length options)))
+ (numbers (mapcar #'number-to-string number-seq))
+ (options-alist (cl-mapcar #'cons numbers titles))
+ (candidates (mastodon-tl--format-read-poll-option options-alist))
+ (choice (completing-read "Poll option to vote for: "
+ candidates nil :match)))
+ (list (cdr (assoc choice candidates)))))))
+
+(defun mastodon-tl-poll-vote (option)
+ "If there is a poll at point, prompt user for OPTION to vote on it."
+ (interactive (mastodon-tl--read-poll-option))
+ (let ((toot (mastodon-tl--property 'item-json)))
+ (if (null (mastodon-tl--field 'poll toot))
+ (user-error "No poll here")
+ (let* ((poll (mastodon-tl--field 'poll toot))
+ (id (alist-get 'id poll))
+ (url (mastodon-http--api (format "polls/%s/votes" id)))
+ ;; zero-index our option:
+ (option-arg (number-to-string
+ (1- (string-to-number (car option)))))
+ (arg `(("choices[]" . ,option-arg)))
+ (response (mastodon-http--post url arg)))
+ (mastodon-http--triage response
+ (lambda (_)
+ (message "You voted for option %s: %s!"
+ (car option) (cdr option))))))))
+
+\f
+;; 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))
+ vids)
+ (cl-loop for x in attachments
+ do (let ((att-type (plist-get x :type)))
+ (when (or (string= "video" att-type)
+ (string= "gifv" att-type))
+ (push x vids))))
+ (car vids)))
+
+(defun mastodon-tl-mpv-play-video-from-byline ()
+ "Run `mastodon-tl-mpv-play-video-at-point' on first moving image in post."
+ (interactive)
+ (let* ((video (mastodon-tl--find-first-video-in-attachments))
+ (url (plist-get video :url))
+ (type (plist-get video :type)))
+ (mastodon-tl-mpv-play-video-at-point url type)))
+
+(defun mastodon-tl-view-full-image-or-play-video (_pos)
+ "View full sized version of image at point, or try to play video."
+ (interactive "d")
+ (if (mastodon-tl--media-video-p)
+ (mastodon-tl-mpv-play-video-at-point)
+ (mastodon-tl-view-full-image-at-point)))
+
+(defun mastodon-tl-click-image-or-video (event)
+ "Click to play video with `mpv.el'.
+EVENT is a mouse-click arg."
+ (interactive "@e")
+ (mastodon-tl-view-full-image-or-play-video
+ (posn-point (event-end event))))
+
+(defun mastodon-tl--media-video-p (&optional type)
+ "T if mastodon-media-type prop is \"gifv\" or \"video\".
+TYPE is a mastodon media type."
+ (let ((type (or type (mastodon-tl--property 'mastodon-media-type :no-move))))
+ (or (string= type "gifv")
+ (string= type "video"))))
+
+(defun mastodon-tl-mpv-play-video-at-point (&optional url type)
+ "Play the video or gif at point with an mpv process.
+URL and TYPE are provided when called while point is on byline,
+in which case play first video or gif from current toot."
+ (interactive)
+ (let ((url (or url ; point in byline:
+ (mastodon-tl--property 'image-url :no-move)))) ; point in toot
+ (if (or (not url)
+ (not (mastodon-tl--media-video-p type)))
+ (user-error "No moving image here?")
+ (message "'q' to kill mpv.")
+ (condition-case x
+ (mpv-start "--loop" url)
+ (void-function
+ (message "Looks like mpv.el not installed. Error: %s"
+ (error-message-string x)))))))
+
+(defun mastodon-tl-copy-image-caption ()
+ "Copy the caption of the image at point."
+ (interactive)
+ (if-let* ((desc (get-text-property (point) 'image-description)))
+ (progn
+ (kill-new desc)
+ (message "Image caption copied."))
+ (message "No image caption.")))
+
+\f
+;;; INSERT TOOTS
+
+(defun mastodon-tl--content (toot)
+ "Retrieve text content from TOOT.
+Runs `mastodon-tl--render-text' and fetches poll or media."
+ (let* ((content (mastodon-tl--field 'content toot))
+ (quote-p (mastodon-tl--field 'quote toot))
+ (rendered (mastodon-tl--render-text content toot))
+ (stripped-maybe (if (not quote-p)
+ rendered
+ (with-temp-buffer ;; strip quoted toot URL:
+ (insert rendered)
+ (goto-char (point-min))
+ (kill-line 2)
+ (buffer-string))))
+ (poll-p (mastodon-tl--field 'poll toot))
+ (media-p (mastodon-tl--field 'media_attachments toot)))
+ (concat stripped-maybe
+ (when poll-p
+ (mastodon-tl--format-poll
+ (mastodon-tl--field 'poll toot))) ;; toot or reblog
+ (when media-p
+ (mastodon-tl--media toot)))))
+
+(defun mastodon-tl--prev-item-id ()
+ "Return the id of the last toot inserted into the buffer."
+ (let* ((prev-change
+ (save-excursion
+ (previous-single-property-change (point) 'base-item-id)))
+ (prev-pos (when prev-change (1- prev-change))))
+ (when prev-pos
+ (get-text-property prev-pos 'base-item-id))))
+
+(defun mastodon-tl--after-reply-status (reply-to-id)
+ "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer."
+ (let ((prev-id (mastodon-tl--prev-item-id)))
+ (string= reply-to-id prev-id)))
+
+(defun mastodon-tl--body-tags (body)
+ "Return a plain string list of the tags in BODY."
+ ;; NB: replies on text props 'mastodon-tab-stop and 'shr-url
+ ;; FIXME: snac tags fail our prop test, not sure about others.
+ (let (list prop)
+ (with-temp-buffer
+ (insert body)
+ (goto-char (point-min))
+ (save-match-data
+ (while
+ (setq prop (text-property-search-forward
+ 'mastodon-tab-stop 'hashtag t))
+ (goto-char (prop-match-beginning prop))
+ (let ((tag (mastodon-tl--property 'mastodon-tag)))
+ (when tag
+ (push (downcase tag) list)))
+ (goto-char (prop-match-end prop)))))
+ list))
+
+(defvar mastodon-tl--quote-states
+ '(pending accepted rejected revoked deleted
+ unauthorized blocked_account blocked_domain muted_account)
+ "A list of possible values for a quote state attribute.
+See https://docs.joinmastodon.org/entities/Quote/#state for details.")
+
+(defun mastodon-tl--quote-symbol-str ()
+ "Return a propertized quote symbol, \"."
+ ;; quote symbol hack:
+ (propertize "“" 'face
+ '( :inherit success :weight bold
+ :height 1.8)))
+
+(defun mastodon-tl--insert-quoted (data toot)
+ "Propertize quoted status DATA for insertion.
+TOOT is the data for the quoting toot."
+ (let* ((bar (concat " " (mastodon-tl--symbol 'reply-bar)))
+ (state (alist-get 'state data))
+ ;; CW status of quoting toot:
+ (cw (not (string-empty-p
+ (mastodon-tl--field 'spoiler_text toot))))
+ (quoted (alist-get 'quoted_status data)))
+ (let-alist quoted
+ (let ((filters (when .filtered
+ (mastodon-tl--current-filters .filtered))))
+ ;; TODO: tailor non-disply of quote based on quote 'state'
+ ;; `mastodon-tl--quote-states':
+ (propertize
+ (cond
+ ((or (assoc "warn" filters)
+ (assoc "hide" filters))
+ ;; FIXME: "warn" should result in CW, but it should be
+ ;; a CW independent of post CW:
+ (mastodon-tl--format-quote-non-display
+ "Quote hidden due to one of your filters"))
+ ;; FIXME: muted account should result in a folded quote
+ ;; (unfoldable):
+ ((string= state "muted_account")
+ (mastodon-tl--format-quote-non-display
+ "Quote hidden, account muted"))
+ ((member state '("rejected" "revoked" "deleted"))
+ (mastodon-tl--format-quote-non-display
+ (format "Quote %s" state)))
+ ((member state '("blocked_account" "blocked_domain"))
+ (mastodon-tl--format-quote-non-display
+ (format "Quote hidden, %s" state)))
+ ((string= state "pending")
+ (mastodon-tl--format-quote-non-display "quote pending"))
+ (t
+ (concat
+ "\n" (mastodon-tl--quote-symbol-str) "\n"
+ ;; author byline without horiz bar/stats:
+ (concat
+ (mastodon-tl--byline-author quoted nil nil :base)
+ "\n"
+ (propertize ;; buttonize quoted toot body
+ ;; quoted text:
+ (mastodon-tl--content quoted)
+ 'button t
+ 'keymap mastodon-tl--link-keymap
+ 'help-echo "Load quoted toot"
+ 'mouse-face '(:inherit (highlight link) :underline nil))))))
+ 'line-prefix bar
+ 'wrap-prefix bar
+ 'quote-url .url
+ 'mastodon-content-warning-body (when cw t)
+ ;; TODO: respect filtering of quoted toot:
+ 'invisible (when cw (mastodon-tl--spoiler-invisible-maybe))
+ 'mastodon-quote data)))))
+
+(defun mastodon-tl--format-quote-non-display (str)
+ "Return a non-displaying quote string for STR."
+ (concat "\n\n" (mastodon-tl--quote-symbol-str) "\n[" str "]"))
+
+;; PUT /api/v1/statuses/:id/interaction_policy
+(defun mastodon-tl--change-post-quote-policy ()
+ "Change the quote policy of the toot at point.
+Toot must be on you own."
+ (interactive)
+ ;; SCOPE: with own toot:
+ (let ((toot (mastodon-tl--property 'item-json :no-move)))
+ (if (not (mastodon-toot--own-toot-p toot))
+ (user-error "You can only set quote policy for your own posts")
+ (let* ((id (mastodon-tl--property 'item-id))
+ (current (car (map-nested-elt toot
+ '(quote_approval automatic))))
+ (choice (completing-read (format "Set quote policy [%s]: " current)
+ mastodon-profiles-quote-policy-types
+ nil :match))
+ (url (mastodon-http--api (format "statuses/%s/interaction_policy"
+ id)))
+ (resp (mastodon-http--put
+ url `(("quote_approval_policy" . ,choice)))))
+ (mastodon-http--triage
+ resp
+ (lambda (resp)
+ (let* ((json (with-current-buffer resp
+ (mastodon-http--process-json)))
+ (set (or (car (map-nested-elt json '(quote_approval automatic)))
+ "nobody"))) ;; nil on the server = nobody
+ (message "Quote policy for post updated to: %s!" set))))))))
+
+(defun mastodon-tl--insert-status
+ (toot body &optional detailed-p thread domain unfolded no-byline
+ cw-expanded)
+ "Display the content and byline of timeline element TOOT.
+BODY will form the section of the toot above the byline.
+DETAILED-P means display more detailed info. For now
+this just means displaying toot client.
+THREAD means the status will be displayed in a thread view.
+When DOMAIN, force inclusion of user's domain in their handle.
+UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
+NO-BYLINE means just insert toot body, used for folding.
+CW-EXPANDED means treat content warnings as unfolded."
+ (let* ((reply-to-id (alist-get 'in_reply_to_id toot))
+ (after-reply-status-p
+ (when (and thread reply-to-id)
+ (mastodon-tl--after-reply-status reply-to-id)))
+ ;; (type (alist-get 'type toot))
+ (toot-foldable
+ (and mastodon-tl--fold-toots-at-length
+ (length> body mastodon-tl--fold-toots-at-length)))
+ (cw-p (not (string-empty-p
+ (alist-get 'spoiler_text toot))))
+ (body-tags (mastodon-tl--body-tags body))
+ (quote (mastodon-tl--field 'quote toot)))
+ (insert
+ (propertize ;; body + byline:
+ (concat
+ (propertize ;; body only:
+ (concat
+ "\n"
+ (mastodon-tl--top-byline toot) ;; (boost, in reply to)
+ ;; relpy symbol:
+ (when (and after-reply-status-p thread)
+ (concat (mastodon-tl--symbol 'replied)
+ "\n"))
+ ;; actual body:
+ (let ((bar (mastodon-tl--symbol 'reply-bar))
+ (body (if (and toot-foldable (not unfolded))
+ (mastodon-tl--fold-body body)
+ body)))
+ (concat
+ (if (and after-reply-status-p thread)
+ (propertize body
+ 'line-prefix bar
+ 'wrap-prefix bar)
+ body)
+ ;; insert quote maybe:
+ (when quote
+ (mastodon-tl--insert-quoted quote toot))))
+ (if (and toot-foldable unfolded cw-expanded)
+ (mastodon-tl--read-more-or-less
+ "LESS" cw-p (not cw-expanded))
+ ""))
+ 'toot-body t) ;; includes newlines etc. for folding
+ ;; post tags:
+ (let ((tags (alist-get 'tags toot)))
+ ;; FIXME: we also need to test here for normal body tags, and if
+ ;; so, don't go ahead:
+ (if tags (concat (mastodon-tl--base-tags tags body-tags)) ""))
+ ;; byline:
+ "\n"
+ (if no-byline
+ ""
+ (mastodon-tl--byline toot detailed-p domain)))
+ 'item-type 'toot
+ 'item-id (alist-get 'id toot) ; toot id
+ 'base-item-id (mastodon-tl--item-id toot) ; with reblog check
+ 'item-json toot
+ 'cursor-face 'mastodon-cursor-highlight-face
+ 'toot-foldable toot-foldable
+ 'toot-folded (and toot-foldable (not unfolded)))
+ (if no-byline "" "\n"))))
+
+(defun mastodon-tl--is-reply (toot)
+ "Check if the TOOT is a reply to another one (and not boosted).
+Used as a predicate in `mastodon-tl--timeline'."
+ (and (mastodon-tl--field 'in_reply_to_id toot)
+ (eq :json-false (mastodon-tl--field 'reblogged toot))))
+
+(defun mastodon-tl--filters-alist (filters)
+ "Parse filter data for FILTERS.
+For each filter, return a list of action (warn or hide), filter
+title, and context."
+ (cl-loop for x in filters ;; includes non filter elts!
+ for f = (alist-get 'filter x)
+ collect (list (alist-get 'filter_action f)
+ (alist-get 'title f)
+ (alist-get 'context f))))
+
+(defun mastodon-tl--filter-by-context (context filters)
+ "Remove FILTERS that don't apply to the current CONTEXT."
+ (cl-remove-if-not
+ (lambda (x)
+ (member context (nth 2 x)))
+ filters))
+
+(defun mastodon-tl--filters-context ()
+ "Return a string of the current buffer's filter context.
+Returns a member of `mastodon-views--filter-types'."
+ ;; FIXME: filters for bookmarks? = home?
+ (let ((buf (mastodon-tl--get-buffer-type)))
+ (cond ((or (eq buf 'local) (eq buf 'federated))
+ "public")
+ ((mastodon-tl--profile-buffer-p)
+ "profile")
+ (
+ ;; (eq buf 'list-timeline)
+ (or (eq buf 'list-timeline) (eq buf 'bookmarks))
+ "home") ;; lists are "home" filter
+ (t ;; thread, notifs, home:
+ (symbol-name buf)))))
+
+(defun mastodon-tl--current-filters (filters)
+ "Return the filters from FILTERS data that apply in the current context.
+For each filter, return a list of action (warn or hide), filter
+title, and context."
+ (let ((context (mastodon-tl--filters-context))
+ (filters-no-context (mastodon-tl--filters-alist filters)))
+ (mastodon-tl--filter-by-context context filters-no-context)))
+
+(defun mastodon-tl--toot (toot &optional detailed-p thread domain
+ unfolded no-byline cw-expanded)
+ "Format TOOT and insert it into the buffer.
+DETAILED-P means display more detailed info. For now
+this just means displaying toot client.
+THREAD means the status will be displayed in a thread view.
+When DOMAIN, force inclusion of user's domain in their handle.
+UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
+NO-BYLINE means just insert toot body, used for folding.
+CW-EXPANDED means treat content warnings as unfolded."
+ (let* ((mastodon-tl--expand-content-warnings
+ (or cw-expanded mastodon-tl--expand-content-warnings))
+ (filtered (mastodon-tl--field 'filtered toot))
+ (filters (when filtered
+ (mastodon-tl--current-filters filtered)))
+ (spoiler-or-content (if-let* ((match (assoc "warn" filters)))
+ (mastodon-tl--spoiler toot (cadr match))
+ (if (mastodon-tl--has-spoiler toot)
+ (mastodon-tl--spoiler toot)
+ (mastodon-tl--content toot)))))
+ (unless (or
+ ;; If any filters are "hide", then we hide,
+ ;; even though item may also have a "warn" filter:
+ (and filtered (assoc "hide" filters)) ;; no insert
+ ;; if account suspended, no-op:
+ ;; https://codeberg.org/martianh/mastodon.el/issues/753
+ ;; a user found post in bookmarks from a suspended user,
+ ;; breaking loading of bookmarks, even though I suspect the
+ ;; server should not even send us such data:
+ (map-nested-elt toot '(account suspended)))
+ (mastodon-tl--insert-status
+ toot (mastodon-tl--clean-tabs-and-nl spoiler-or-content)
+ detailed-p thread domain unfolded no-byline cw-expanded))))
+
+(defun mastodon-tl--timeline (toots &optional thread domain no-byline)
+ "Display each toot in TOOTS.
+This function removes replies if user required.
+THREAD means the status will be displayed in a thread view.
+When DOMAIN, force inclusion of user's domain in their handle.
+NO-BYLINE means just insert toot body, used for folding."
+ (let ((start-pos (point))
+ (toots ;; hack to *not* filter replies on profiles:
+ (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses)
+ toots
+ (if (or ; we were called via --more*:
+ (mastodon-tl--buffer-property 'hide-replies nil :no-error)
+ ;; loading a tl with a prefix arg:
+ (mastodon-tl--hide-replies-p current-prefix-arg))
+ (cl-remove-if-not #'mastodon-tl--is-reply toots)
+ toots))))
+ (cl-loop for toot in toots
+ do (mastodon-tl--toot toot nil thread domain nil no-byline))
+ ;; media:
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images start-pos (point)))
+ (goto-char (point-min))))
+
+;;; FOLDING
+
+(defun mastodon-tl--read-more-or-less (str cw invis)
+ "Return a read more or read less heading.
+STR is an uppercase string, either MORE or LESS.
+The heading is a link to toggle the fold status of the toot.
+CW and INVIS are boolean values for the properties invisible and
+mastodon-content-warning-body."
+ (let ((type (if (string= str "MORE") 'read-more 'read-less)))
+ (propertize
+ (mastodon-search--format-heading
+ (mastodon-tl--make-link (format "READ %s" str) type)
+ nil :no-newline)
+ 'mastodon-content-warning-body cw
+ 'invisible invis)))
+
+(defun mastodon-tl--fold-body (body)
+ "Fold toot BODY if it is very long.
+Folding decided by `mastodon-tl--fold-toots-at-length'."
+ (let* ((invis (get-text-property (1- (length body)) 'invisible body))
+ (cw (get-text-property (1- (length body))
+ 'mastodon-content-warning-body body))
+ (heading (mastodon-tl--read-more-or-less "MORE" cw invis))
+ (display (concat (substring body 0
+ mastodon-tl--fold-toots-at-length)
+ heading)))
+ (propertize display
+ 'read-more body)))
+
+(defun mastodon-tl--load-images-fold ()
+ "Check for unloaded images on (un)fold and load if found."
+ (when mastodon-tl--display-media-p
+ (let ((prev-point
+ (save-excursion
+ (let ((pb (point)))
+ (mastodon-tl-goto-prev-item :norefresh)
+ ;; our prev-item implementation is awful, so we just check
+ ;; if we moved, if we didn't, assume we are first item, so
+ ;; return point-min and use it:
+ (if (eq (point) pb)
+ (point-min)
+ (point))))))
+ (mastodon-media--inline-images prev-point (point)))))
+
+(defun mastodon-tl-unfold-post (&optional fold)
+ "Unfold the toot at point if it is folded (read-more).
+FOLD means to fold it instead."
+ (interactive)
+ (let ((at-byline (mastodon-tl--property 'byline :no-move)))
+ (if (save-excursion
+ (when (not at-byline)
+ (mastodon-tl-goto-next-item))
+ (not (mastodon-tl--property 'toot-foldable :no-move)))
+ (user-error "No foldable item at point?")
+ (let* ((inhibit-read-only t)
+ (body-range (mastodon-tl--find-property-range 'toot-body
+ (point) :backward))
+ (cw-range (mastodon-tl--find-property-range
+ 'mastodon-content-warning-body
+ (point) :backward))
+ (cw-invis (when cw-range
+ (get-text-property (car cw-range) 'invisible)))
+ (toot (mastodon-tl--property 'item-json :no-move))
+ ;; `replace-region-contents' is much too slow, our hack from
+ ;; fedi.el is much simpler and much faster:
+ (beg (car body-range))
+ (end (cdr body-range))
+ (last-point (point))
+ (point-after-fold (> last-point
+ (+ beg mastodon-tl--fold-toots-at-length))))
+ ;; save-excursion here useless actually:
+ ;; FIXME: because point goes to top of item, the screen gets scrolled
+ ;; by insertion
+ (goto-char beg)
+ (delete-region beg end)
+ (delete-char 1) ;; prevent newlines accumulating
+ ;; insert toot body:
+ (mastodon-tl--toot toot nil nil nil (not fold) :no-byline
+ (unless cw-invis :cw-expanded)) ;; respect CW state
+ ;; set toot-folded prop on entire toot (not just body):
+ (let ((toot-range ;; post fold action range:
+ (mastodon-tl--find-property-range 'item-json
+ (point) :backward)))
+ (add-text-properties (car toot-range)
+ (cdr toot-range)
+ `(toot-folded ,fold)))
+ ;; load unfolded images maybe:
+ (mastodon-tl--load-images-fold)
+ ;; try to leave point somewhere sane:
+ (cond ((or at-byline
+ (and fold point-after-fold)) ;; point was in area now folded
+ (ignore-errors (forward-line -1)) ;; in case we are between
+ (mastodon-tl-goto-next-item)) ;; goto byline
+ (t
+ (goto-char last-point)
+ (when point-after-fold ;; point was in READ MORE heading:
+ (beginning-of-line))))
+ (message (format "%s toot" (if fold "Fold" "Unfold")))))))
+
+(defun mastodon-tl-fold-post ()
+ "Fold post at point, if it is too long."
+ (interactive)
+ (mastodon-tl-unfold-post :fold))
+
+(defun mastodon-tl-fold-post-toggle ()
+ "Toggle the folding status of the toot at point."
+ (interactive)
+ (let* ((folded (mastodon-tl--property 'toot-folded :no-move)))
+ (mastodon-tl-unfold-post (not folded))))
+
+;;; TOOT STATS
+
+;; calqued off mastodon-alt.el:
+(defun mastodon-tl--toot-for-stats (&optional toot)
+ ;; FIXME: just use `mastodon-tl-toot-or-base'?
+ "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) 'item-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'."
+ (let-alist (mastodon-tl--toot-for-stats toot)
+ (let* ((faves-prop (propertize (format "%s" .favourites_count)
+ 'favourites-count .favourites_count))
+ (boosts-prop (propertize (format "%s" .reblogs_count)
+ 'boosts-count .reblogs_count))
+ (faves (format "%s %s" faves-prop (mastodon-tl--symbol 'favourite)))
+ (boosts (format "%s %s" boosts-prop (mastodon-tl--symbol 'boost)))
+ (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply)))
+ (quotes (when .quotes_count
+ (format "%s %s"
+ (propertize (number-to-string .quotes_count)
+ 'face 'mastodon-toot-docs-face)
+ (propertize (mastodon-tl--symbol 'quote)
+ 'face '(:inherit success :box t)))))
+ (stats (concat
+ (propertize faves
+ 'favourited-p (eq t .favourited)
+ 'favourites-field t
+ 'help-echo (format "%s favourites" .favourites_count)
+ 'face 'mastodon-toot-docs-face)
+ (propertize " | " 'face 'mastodon-toot-docs-face)
+ (propertize boosts
+ 'boosted-p (eq t .reblogged)
+ 'boosts-field t
+ 'help-echo (format "%s boosts" .reblogs_count)
+ 'face 'mastodon-toot-docs-face)
+ (propertize " | " 'face 'mastodon-toot-docs-face)
+ (propertize replies
+ 'replies-field t
+ 'replies-count .replies_count
+ 'help-echo (format "%s replies" .replies_count)
+ 'face 'mastodon-toot-docs-face)
+ (propertize " | " 'face 'mastodon-toot-docs-face)
+ (when .quotes_count
+ (propertize quotes
+ 'quotes-field t
+ 'quotes-count .quotes_count
+ 'help-echo (format "%s quotes" .quotes_count)
+ ;; 'face 'mastodon-toot-docs-face
+ ))))
+ (right-spacing
+ (propertize " "
+ 'display
+ `(space :align-to (- right ,(+ (length stats) 7))))))
+ (concat right-spacing stats))))
+
+\f
+;;; BUFFER SPEC
+
+(defun mastodon-tl--update-function (&optional buffer)
+ "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'.
+Optionally get it for BUFFER."
+ (mastodon-tl--buffer-property 'update-function buffer))
+
+(defun mastodon-tl--endpoint (&optional buffer no-error)
+ "Get the ENDPOINT stored in `mastodon-tl--buffer-spec'.
+Optionally set it for BUFFER.
+NO-ERROR means to fail silently."
+ (mastodon-tl--buffer-property 'endpoint buffer no-error))
+
+(defun mastodon-tl--buffer-name (&optional buffer no-error)
+ "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'.
+Optionally get it for BUFFER.
+NO-ERROR means to fail silently."
+ (mastodon-tl--buffer-property 'buffer-name buffer no-error))
+
+(defun mastodon-tl--link-header (&optional buffer)
+ "Get the LINK HEADER stored in `mastodon-tl--buffer-spec'.
+Optionally get it for BUFFER."
+ (mastodon-tl--buffer-property 'link-header buffer :no-error))
+
+(defun mastodon-tl--update-params (&optional buffer)
+ "Get the UPDATE PARAMS stored in `mastodon-tl--buffer-spec'.
+Optionally get it for BUFFER."
+ (mastodon-tl--buffer-property 'update-params buffer :no-error))
+
+(defun mastodon-tl--buffer-property (property &optional buffer no-error)
+ "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'.
+If NO-ERROR is non-nil, do not error when property is empty."
+ (with-current-buffer (or buffer (current-buffer))
+ (if no-error
+ (plist-get mastodon-tl--buffer-spec property)
+ (or (plist-get mastodon-tl--buffer-spec property)
+ (error "Mastodon-tl--buffer-spec not defined for buffer %s, prop %s"
+ (or buffer (current-buffer))
+ property)))))
+
+(defun mastodon-tl--set-buffer-spec
+ (buffer endpoint update-fun
+ &optional link-header update-params hide-replies max-id
+ thread-item-id)
+ "Set `mastodon-tl--buffer-spec' for the current buffer.
+BUFFER is buffer name, ENDPOINT is buffer's enpoint,
+UPDATE-FUN is its update function.
+LINK-HEADER is the http Link header if present.
+UPDATE-PARAMS is any http parameters needed for the update function.
+HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer.
+MAX-ID is the pagination parameter.
+THREAD-ITEM-ID is the ID of the item in thread that we opened the thread with."
+ (setq mastodon-tl--buffer-spec
+ `( account ,(cons mastodon-active-user mastodon-instance-url)
+ buffer-name ,buffer
+ endpoint ,endpoint
+ update-function ,update-fun
+ link-header ,link-header
+ update-params ,update-params
+ hide-replies ,hide-replies
+ max-id ,max-id
+ thread-item-id ,thread-item-id)))
+
+\f
+;;; BUFFERS
+
+(defun mastodon-tl--endpoint-str-= (str &optional type)
+ "Return T if STR is equal to the current buffer's endpoint.
+TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix."
+ (let ((endpoint-fun (mastodon-tl--endpoint nil :no-error)))
+ (cond ((eq type :prefix)
+ (string-prefix-p str endpoint-fun))
+ ((eq type :suffix)
+ (string-suffix-p str endpoint-fun))
+ (t
+ (string= str endpoint-fun)))))
+
+(defun mastodon-tl--get-buffer-type ()
+ "Return a symbol descriptive of current mastodon buffer type.
+Should work in all mastodon buffers.
+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 ((buffer-name (mastodon-tl--buffer-name nil :no-error)))
+ (cond (mastodon-toot-mode
+ ;; composing/editing (no buffer spec):
+ (if (string= "*edit toot*" (buffer-name))
+ 'edit-toot
+ 'new-toot))
+ ;; main timelines:
+ ((mastodon-tl--endpoint-str-= "timelines/home")
+ 'home)
+ ((string= "*mastodon-local*" buffer-name)
+ 'local)
+ ((mastodon-tl--endpoint-str-= "timelines/public")
+ 'federated)
+ ((mastodon-tl--endpoint-str-= "timelines/tag/" :prefix)
+ 'tag-timeline)
+ ((mastodon-tl--endpoint-str-= "timelines/list/" :prefix)
+ 'list-timeline)
+ ;; notifs:
+ ((string-suffix-p "mentions*" buffer-name)
+ 'mentions)
+ ((mastodon-tl--endpoint-str-= "notifications")
+ 'notifications)
+ ((mastodon-tl--endpoint-str-= "notifications/requests")
+ 'notification-requests)
+ ;; threads:
+ ((mastodon-tl--endpoint-str-= "context" :suffix)
+ 'thread)
+ ((mastodon-tl--endpoint-str-= "statuses" :prefix)
+ 'single-status)
+ ;; profiles:
+ ((mastodon-tl--profile-buffer-p)
+ (cond
+ ;; an own profile option is needlessly confusing e.g. for
+ ;; `mastodon-profile-account-view-cycle'
+ ;; profile note:
+ ((string-suffix-p "update-profile*" buffer-name)
+ 'update-profile-note)
+ ;; posts inc. boosts:
+ ((string-suffix-p "no-boosts*" buffer-name)
+ 'profile-statuses-no-boosts)
+ ((string-suffix-p "no-replies*" buffer-name)
+ 'profile-statuses-no-replies)
+ ((string-suffix-p "only-media*" buffer-name)
+ 'profile-statuses-only-media)
+ ((string-match-p "-tagged-" buffer-name)
+ 'profile-statuses-tagged)
+ ((mastodon-tl--endpoint-str-= "statuses" :suffix)
+ 'profile-statuses)
+ ;; profile followers
+ ((mastodon-tl--endpoint-str-= "followers" :suffix)
+ 'profile-followers)
+ ;; profile following
+ ((mastodon-tl--endpoint-str-= "following" :suffix)
+ 'profile-following)))
+ ((mastodon-tl--endpoint-str-= "preferences")
+ 'preferences)
+ ;; search
+ ((mastodon-tl--search-buffer-p)
+ (cond ((string= "accounts" (mastodon-search--buf-type))
+ 'search-accounts)
+ ((string= "hashtags" (mastodon-search--buf-type))
+ 'search-hashtags)
+ ((string= "statuses" (mastodon-search--buf-type))
+ 'search-statuses)))
+ ;; trends
+ ((mastodon-tl--endpoint-str-= "trends/statuses")
+ 'trending-statuses)
+ ((mastodon-tl--endpoint-str-= "trends/tags")
+ 'trending-tags)
+ ((mastodon-tl--endpoint-str-= "trends/links")
+ 'trending-links)
+ ;; User's views:
+ ((mastodon-tl--endpoint-str-= "filters")
+ 'filters)
+ ((mastodon-tl--endpoint-str-= "lists")
+ 'lists)
+ ((mastodon-tl--endpoint-str-= "suggestions")
+ 'follow-suggestions)
+ ((mastodon-tl--endpoint-str-= "favourites")
+ 'favourites)
+ ((mastodon-tl--endpoint-str-= "bookmarks")
+ 'bookmarks)
+ ((mastodon-tl--endpoint-str-= "follow_requests")
+ 'follow-requests)
+ ((mastodon-tl--endpoint-str-= "scheduled_statuses")
+ 'scheduled-statuses)
+ ;; instance description
+ ((mastodon-tl--endpoint-str-= "instance")
+ 'instance-description)
+ ((string= "*mastodon-toot-edits*" buffer-name)
+ 'toot-edits)
+ ((string= "*masto-image*" (buffer-name))
+ 'mastodon-image)
+ ((mastodon-tl--endpoint-str-= "timelines/link")
+ 'link-timeline)
+ ((mastodon-tl--endpoint-str-= "announcements")
+ 'announcements)
+ ;; followed hashtags
+ ((mastodon-tl--endpoint-str-= "followed_tags")
+ 'followed-hashtags))))
+
+(defun mastodon-tl--buffer-type-eq (type)
+ "Return t if current buffer type is equal to symbol TYPE."
+ (eq (mastodon-tl--get-buffer-type) type))
+
+(defun mastodon-tl--profile-buffer-p ()
+ "Return t if current buffer is a profile buffer of any kind.
+This includes the update profile note buffer, but not the preferences one."
+ (string-prefix-p "accounts" (mastodon-tl--endpoint nil :no-error)))
+
+(defun mastodon-tl--own-profile-buffer-p ()
+ "Return t if we are viewing our own profile buffer.
+We check that our account credientials id matches the endpoint id in the
+buffer spec, which if in a profile buffer is of the form
+\"accounts/$id/statuses\"."
+ (and (mastodon-tl--profile-buffer-p)
+ (let ((endpoint-id
+ (nth 1
+ (split-string (mastodon-tl--endpoint) "/"))))
+ (string= (mastodon-auth--get-account-id)
+ endpoint-id))))
+
+(defun mastodon-tl--search-buffer-p ()
+ "T if current buffer is a search buffer."
+ (string-suffix-p "search" (mastodon-tl--endpoint nil :no-error)))
+
+(defun mastodon-tl--timeline-proper-p ()
+ "Return non-nil if the current buffer is a \"proper\" timeline.
+A proper timeline excludes notifications, threads, profiles, and
+other toot buffers that aren't strictly mastodon timelines."
+ (let ((timeline-buffers
+ '(home federated local tag-timeline list-timeline profile-statuses)))
+ (member (mastodon-tl--get-buffer-type) timeline-buffers)))
+
+(defun mastodon-tl--hide-replies-p (&optional prefix)
+ "Return non-nil if replies should be hidden in the timeline.
+We hide replies if user explictly set the
+`mastodon-tl--hide-replies' or used PREFIX combination to open a
+timeline."
+ (and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline
+ (or (mastodon-tl--buffer-property 'hide-replies nil :noerror)
+ mastodon-tl--hide-replies ; User configured to hide replies
+ (equal '(4) prefix)))) ; Timeline called with C-u prefix
+
+\f
+;;; UTILITIES
+
+(defun mastodon-tl--clean-tabs-and-nl (string)
+ "Remove tabs and newlines from STRING."
+ (replace-regexp-in-string "[\t\n ]*\\'" "" string))
+
+(defun mastodon-tl--map-alist (key alists &optional testfn)
+ "Return a list of values extracted from ALISTS with KEY.
+Key is a symbol, as with `alist-get', or else compatible with TESTFN.
+ALISTS is a list of alists."
+ ;; this actually for a list of alists, right? so change the arg?
+ (cl-loop for x in alists
+ collect (alist-get key x nil nil testfn)))
+
+(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."
+ (cl-loop for x in alist
+ collect (cons (alist-get key1 x)
+ (alist-get key2 x))))
+
+(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--field-status (field toot)
+ "Return FIELD from TOOT.
+Return value from status field if available."
+ (or (alist-get field (alist-get 'status 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 NO-MOVE is non-nil.
+BACKWARD means move backward (up) the timeline."
+ (if no-move
+ (get-text-property (point) prop)
+ ;; NB: this doesn't differentiate absence of property from
+ ;; property set to zero, making flag props fraught:
+ (or (get-text-property (point) prop)
+ (save-excursion
+ (if backward
+ (mastodon-tl-goto-prev-item)
+ (mastodon-tl-goto-next-item))
+ (get-text-property (point) prop)))))
+
+(defun mastodon-tl--newest-id ()
+ "Return item-id from the top of the buffer.
+If we are in a notifications view, return `notifications-max-id'."
+ (save-excursion
+ (goto-char (point-min))
+ (mastodon-tl--property
+ (if (eq (mastodon-tl--get-buffer-type)
+ (member (mastodon-tl--get-buffer-type)
+ '(mentions notifications)))
+ 'notifications-max-id
+ 'item-id))))
+
+(defun mastodon-tl--oldest-id ()
+ "Return item-id from the bottom of the buffer.
+If we are in a notifications view, return `notifications-min-id'."
+ (save-excursion
+ (goto-char (point-max))
+ (mastodon-tl--property
+ (if (and mastodon-group-notifications
+ (member (mastodon-tl--get-buffer-type)
+ '(mentions notifications)))
+ 'notifications-min-id
+ 'item-id)
+ nil :backward)))
+
+(defun mastodon-tl--as-string (numeric)
+ "Convert NUMERIC to string."
+ (cond ((numberp numeric)
+ (number-to-string numeric))
+ ((stringp numeric) numeric)
+ (t (error "Numeric: %s must be either a string or a number"
+ numeric))))
+
+(defun mastodon-tl--item-id (json)
+ "Find approproiate toot id in JSON.
+If the toot has been boosted use the id found in the
+reblog portion of the toot. Otherwise, use the body of
+the toot. This is the same behaviour as the mastodon.social
+webapp"
+ (let-alist json
+ (if .reblog .reblog.id .id)))
+
+(defun mastodon-tl--toot-or-base (json)
+ "Return the base toot or just the toot from toot JSON."
+ (or (alist-get 'reblog json) json))
+
+\f
+;;; THREADS
+
+(defun mastodon-tl-view-single-toot ()
+ "View toot at point in a separate buffer."
+ (interactive)
+ (let ((id (mastodon-tl--property 'base-item-id)))
+ (mastodon-tl--single-toot id)))
+
+(defun mastodon-tl--single-toot (id)
+ "View toot in separate buffer.
+ID is that of the toot to view."
+ (let* ((buffer (format "*mastodon-toot-%s*" id))
+ (toot (mastodon-http--get-json
+ (mastodon-http--api (concat "statuses/" id)))))
+ (if (eq (caar toot) 'error)
+ (user-error "Error: %s" (cdar toot))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id)
+ #'mastodon-tl--update-toot
+ ;; id for reload on reply:
+ nil nil nil nil id)
+ (mastodon-tl--toot toot :detailed-p)
+ (goto-char (point-min))
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images (point-min)
+ (point-max)))
+ (mastodon-tl-goto-next-item :no-refresh)))))
+
+(defun mastodon-tl--update-toot (json)
+ "Call `mastodon-tl-single-toot' on id found in JSON."
+ (let ((id (alist-get 'id json)))
+ (mastodon-tl--single-toot id)))
+
+(defun mastodon-tl-view-whole-thread ()
+ "From a thread view, view entire thread.
+If you load a thread from a toot, only the branches containing
+are displayed by default. Call this if you subsequently want to
+view all branches of a thread."
+ (interactive)
+ (if (not (eq (mastodon-tl--get-buffer-type) 'thread))
+ (user-error "You need to be viewing a thread to call this")
+ (goto-char (point-min))
+ (let ((id (mastodon-tl--property 'base-item-id)))
+ (mastodon-tl--thread-do id))))
+
+(defun mastodon-tl-return ()
+ "Load user profile or thread of item at point.
+If item at point is a follow or follow request, load user profile.
+Else load thread."
+ (interactive)
+ (let ((notif (mastodon-tl--property 'notification-type)))
+ (if (or (equal "follow" notif)
+ (equal "follow_request" notif))
+ (let* ((json (mastodon-tl--property 'item-json))
+ (handle (alist-get 'acct json)))
+ (mastodon-profile-show-user handle))
+ (mastodon-tl-thread))))
+
+(defun mastodon-tl-thread ()
+ "Open thread buffer for toot at point."
+ (interactive)
+ (if (not (eq 'toot (mastodon-tl--property 'item-type :no-move)))
+ (user-error "Looks like there's no toot at point?")
+ (mastodon-tl--thread-do)))
+
+(defun mastodon-tl--thread-do (&optional thread-id)
+ "Open thread buffer for toot at point or with THREAD-ID.
+This is the non-interactive version, so we can call it
+programmatically and not crash into
+`mastodon-toot--with-toot-item'."
+ ;; this function's var must not be id as the above macro binds id and
+ ;; even if we provide the arg (e.g. url-lookup), the macro definition
+ ;; overrides it, making the optional arg unusable!
+ (let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move)))
+ (type
+ (if (and (mastodon-tl--buffer-type-eq 'notifications)
+ mastodon-group-notifications)
+ (mastodon-tl--property 'notification-type)
+ (mastodon-tl--field 'type
+ (mastodon-tl--property 'item-json :no-move))))
+ (unfolded-state (mastodon-tl--buffer-property 'thread-unfolded
+ (current-buffer) :noerror))
+ (mastodon-tl--expand-content-warnings
+ ;; if reloading and thread was explicitly (un)folded, respect it:
+ (or (pcase unfolded-state
+ ('folded nil)
+ ('unfolded t)
+ (_ mastodon-tl--expand-content-warnings)))))
+ (if (or (string= type "follow_request")
+ (string= type "follow")) ; no can thread these
+ (user-error "No thread")
+ (let* ((endpoint (format "statuses/%s/context" id))
+ (url (mastodon-http--api endpoint))
+ (buffer (format "*mastodon-thread-%s*" id))
+ (toot (mastodon-http--get-json ; refetch in case we just faved/boosted:
+ (mastodon-http--api (concat "statuses/" id))
+ nil :silent))
+ (context (mastodon-http--get-json url nil :silent)))
+ (if (eq (caar toot) 'error)
+ (user-error "Error: %s" (cdar toot))
+ (when (member (alist-get 'type toot) '("reblog" "favourite"))
+ (setq toot (alist-get 'status toot)))
+ (if (not (< 0 (+ (length (alist-get 'ancestors context))
+ (length (alist-get 'descendants context)))))
+ ;; just print the lone toot:
+ (mastodon-tl--single-toot id)
+ ;; we have a thread:
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (let ((marker (make-marker)))
+ (mastodon-tl--set-buffer-spec buffer endpoint
+ #'mastodon-tl--thread-do
+ nil nil nil nil id)
+ (when unfolded-state
+ (plist-put mastodon-tl--buffer-spec
+ 'thread-unfolded unfolded-state))
+ (when-let* ((ancestors (alist-get 'ancestors context)))
+ (mastodon-tl--timeline ancestors :thread))
+ (goto-char (point-max))
+ (move-marker marker (point))
+ ;; print re-fetched toot:
+ (mastodon-tl--toot toot :detailed-p :thread)
+ ;; inline images only for the toot
+ ;; (`mastodon-tl--timeline' handles the rest):
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images marker ;start-pos
+ (point)))
+ (when-let* ((descendants (alist-get 'descendants context)))
+ (mastodon-tl--timeline descendants :thread))
+ ;; put point at the toot:
+ (goto-char (marker-position marker))
+ (mastodon-tl-goto-next-item :no-refresh)))))))))
+
+(defun mastodon-tl-mute-thread ()
+ "Mute the thread displayed in the current buffer.
+Note that you can only (un)mute threads you have posted in."
+ (interactive)
+ (mastodon-tl--mute-or-unmute-thread))
+
+(defun mastodon-tl-unmute-thread ()
+ "Unmute the thread displayed in the current buffer.
+Note that you can only (un)mute threads you have posted in."
+ (interactive)
+ (mastodon-tl--mute-or-unmute-thread :unmute))
+
+(defun mastodon-tl--thread-parent-id ()
+ "Return the ID of the top item in a thread."
+ (save-excursion
+ (mastodon-tl--goto-first-item)
+ (mastodon-tl--property 'base-item-id :no-move)))
+
+(defun mastodon-tl--mute-or-unmute-thread (&optional unmute)
+ "Mute a thread.
+If UNMUTE, unmute it."
+ (let ((mute-str (if unmute "unmute" "mute")))
+ (when (or (mastodon-tl--buffer-type-eq 'thread)
+ (mastodon-tl--buffer-type-eq 'notifications))
+ (let* ((id
+ ;; the id for `mastodon-tl--user-in-thread-p' ought to be the
+ ;; top-level item:
+ (if (mastodon-tl--buffer-type-eq 'notifications)
+ (mastodon-tl--property 'base-item-id :no-move)
+ (mastodon-tl--thread-parent-id)))
+ (we-posted-p (mastodon-tl--user-in-thread-p id))
+ (url (mastodon-http--api (format "statuses/%s/%s" id mute-str))))
+ (if (not we-posted-p)
+ (user-error "You can only (un)mute a thread you have posted in")
+ (when (y-or-n-p (format "%s this thread? " mute-str))
+ (let ((response (mastodon-http--post url)))
+ (mastodon-http--triage
+ response
+ (lambda (_)
+ (message (format "Thread %sd!" mute-str)))))))))))
+
+(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)
+ (map-nested-elt status '(account id)))
+ 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."
+ (let* ((context-json (mastodon-http--get-json
+ (mastodon-http--api (format "statuses/%s/context" id))
+ nil :silent))
+ (ancestors (alist-get 'ancestors context-json))
+ (descendants (alist-get 'descendants context-json))
+ (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))))
+
+\f
+;;; FOLLOW/BLOCK/MUTE, ETC
+
+(defun mastodon-tl-follow-user (user-handle
+ &optional notify langs reblogs json)
+ "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.
+LANGS is an array parameters alist of languages to filer user's posts by.
+REBLOGS is a boolean string like NOTIFY, enabling or disabling
+display of the user's boosts in your timeline.
+JSON is a flag arg for `mastodon-http--post'."
+ (interactive (list (mastodon-tl--user-handles-get "follow")))
+ (mastodon-tl--do-if-item
+ (mastodon-tl--do-user-action-and-response
+ user-handle "follow" nil notify langs reblogs json)))
+
+(defun mastodon-tl-follow-user-by-handle (user-handle)
+ "Prompt for a USER-HANDLE and follow that user.
+USER-HANDLE can also be a URL to a user profile page."
+ ;; code adapted from sachac:
+ ;; https://sachachua.com/dotemacs/index.html#mastodon. thanks sachac!
+ (interactive "MHandle: ")
+ (when (string-match "https?://\\(.+?\\)/\\(@.+\\)" user-handle)
+ (setq user-handle
+ ;; sachac's model doesn't work with local user handles in URL,
+ ;; meaning the search below will fail, so we use our own
+ ;; URL-to-handle function, modified for the purpose:
+ ;; (concat (match-string 2 user-handle) "@" (match-string 1 user-handle))))
+ (mastodon-tl--userhandle-from-url user-handle)))
+ (let* ((account (mastodon-profile--search-account-by-handle
+ user-handle))
+ (user-id (alist-get 'id account))
+ (name (if (not (string-empty-p
+ (alist-get 'display_name account)))
+ (alist-get 'display_name account)
+ (alist-get 'username account)))
+ (url (mastodon-http--api (format "accounts/%s/%s" user-id "follow"))))
+ (if account
+ (mastodon-tl--do-user-action-function url name
+ (substring user-handle 1) "follow")
+ (user-error "Cannot find a user with handle %S" user-handle))))
+
+;; TODO: make this action "enable/disable notifications"
+(defun mastodon-tl-enable-notify-user-posts (user-handle)
+ "Query for USER-HANDLE and enable notifications when they post."
+ (interactive (list (mastodon-tl--user-handles-get "enable")))
+ (mastodon-tl--do-if-item
+ (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."
+ (interactive (list (mastodon-tl--user-handles-get "disable")))
+ (mastodon-tl-follow-user user-handle "false"))
+
+(defun mastodon-tl-follow-user-disable-boosts (user-handle)
+ "Prompt for a USER-HANDLE, and disable display of boosts in home timeline.
+If they are also not yet followed, follow them."
+ (interactive (list (mastodon-tl--user-handles-get "disable boosts")))
+ (mastodon-tl-follow-user user-handle nil nil "false"))
+
+(defun mastodon-tl-follow-user-enable-boosts (user-handle)
+ "Prompt for a USER-HANDLE, and enable display of boosts in home timeline.
+If they are also not yet followed, follow them.
+You only need to call this if you have previously disabled
+display of boosts."
+ (interactive (list (mastodon-tl--user-handles-get "enable boosts")))
+ (mastodon-tl-follow-user user-handle nil nil "true"))
+
+(defun mastodon-tl-filter-user-user-posts-by-language (user-handle)
+ "Query for USER-HANDLE and filter display of their posts by language.
+If they are not already followed, they will be too.
+To be filtered, a post has to be marked as in the language given.
+This may mean that you will not see posts that are in your
+desired language if they are not marked as such (or as anything)."
+ (interactive (list (mastodon-tl--user-handles-get "filter by language")))
+ (let ((langs (mastodon-tl--read-filter-langs)))
+ (mastodon-tl--do-if-item
+ (if (string= "" (cdar langs))
+ (mastodon-tl-unfilter-user-languages user-handle)
+ (mastodon-tl-follow-user user-handle nil langs)))))
+
+(defun mastodon-tl-unfilter-user-languages (user-handle)
+ "Remove any language filters for USER-HANDLE.
+This means you will receive posts of theirs marked as being in
+any or no language."
+ (interactive (list (mastodon-tl--user-handles-get "filter by language")))
+ (let ((langs "languages[]"))
+ (mastodon-tl--do-if-item
+ ;; we need "languages[]" as a param, with no "=" and not json-encoded as
+ ;; a string
+ (mastodon-tl-follow-user user-handle nil langs nil :raw))))
+
+(defun mastodon-tl--read-filter-langs (&optional langs)
+ "Read language choices and return an alist array parameter.
+LANGS is the accumulated array param alist if we re-run recursively."
+ (let* ((iso-const mastodon-iso-639-1)
+ (iso (cons '("None (all)" . "") iso-const))
+ (langs-alist langs)
+ (choice (completing-read "Filter user's posts by language: "
+ iso)))
+ (when choice
+ (setq langs-alist
+ (push `("languages[]" . ,(alist-get choice iso
+ nil nil #'string=))
+ langs-alist))
+ (if (y-or-n-p "Filter by another language? ")
+ (mastodon-tl--read-filter-langs langs-alist)
+ langs-alist))))
+
+(defun mastodon-tl-unfollow-user (user-handle)
+ "Query for USER-HANDLE from current status and unfollow that user."
+ (interactive (list (mastodon-tl--user-handles-get "unfollow")))
+ (mastodon-tl--do-if-item
+ (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--user-handles-get "block")))
+ (mastodon-tl--do-if-item
+ (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."
+ (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unblock")))
+ (if (not user-handle)
+ (user-error "Looks like you have no blocks to unblock!")
+ (mastodon-tl--do-user-action-and-response user-handle "unblock" t)))
+
+(defun mastodon-tl-mute-user (user-handle)
+ "Query for USER-HANDLE from current status and mute that user."
+ (interactive (list (mastodon-tl--user-handles-get "mute")))
+ (mastodon-tl--do-if-item
+ (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."
+ (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unmute")))
+ (if (not user-handle)
+ (user-error "Looks like you have no mutes to unmute!")
+ (mastodon-tl--do-user-action-and-response user-handle "unmute" t)))
+
+(defun mastodon-tl-dm-user (user-handle)
+ "Query for USER-HANDLE from current status and compose a message to that user."
+ (interactive (list (mastodon-tl--user-handles-get "message")))
+ (mastodon-tl--do-if-item
+ (mastodon-toot--compose-buffer (concat "@" user-handle))
+ (setq mastodon-toot--visibility "direct")
+ (mastodon-toot--update-status-fields)))
+
+(defun mastodon-tl-read-handle-annotated (user-handles prompt)
+ "Read a handle from data USER-HANDLES with PROMPT.
+Annotate the candidates with display name or user name."
+ (let* ((item-json (mastodon-profile--item-json))
+ (notif-accts (mastodon-tl--property 'notification-accounts :nomove))
+ (completion-extra-properties
+ `(:annotation-function
+ ,(lambda (cand)
+ (let ((user
+ (or
+ ;; mentions:
+ (mastodon-tl--find-user cand
+ (alist-get 'mentions
+ (mastodon-tl--toot-or-base item-json)))
+ ;; notifs:
+ (mastodon-tl--find-user cand notif-accts)
+ ;; booster/faver:
+ (when (string= cand
+ (map-nested-elt item-json
+ '(account acct)))
+ (alist-get 'account item-json))
+ ;; author:
+ (let ((data (mastodon-tl--toot-or-base item-json)))
+ (when (string= cand
+ (map-nested-elt data
+ '(account acct)))
+ (alist-get 'account data))))))
+ (when user
+ (concat
+ (propertize " "
+ 'display '(space :align-to 40))
+ (propertize (or (alist-get 'display_name user)
+ (alist-get 'username user))
+ 'face 'mastodon-display-name-face))))))))
+ (completing-read prompt user-handles nil 'confirm)))
+
+(defun mastodon-tl--user-handles-get (action)
+ "Get the list of user-handles for ACTION from the current toot."
+ (mastodon-tl--do-if-item
+ (let ((user-handles
+ (cond
+ ((or ; follow suggests / search / foll requests compat:
+ (member (mastodon-tl--get-buffer-type)
+ '( follow-suggestions search follow-requests
+ ;; profile follows/followers but not statuses:
+ profile-followers profile-following)))
+ ;; fetch 'item-json:
+ (list (alist-get 'acct
+ (mastodon-tl--property 'item-json :no-move))))
+ ;; profile view, point in profile details, poss 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
+ (mastodon-profile--profile-json))))
+ ;; (grouped) notifications:
+ ((member (mastodon-tl--get-buffer-type) '(mentions notifications))
+ (append ;; those acting on item:
+ (cl-remove-duplicates
+ (cl-loop for a in (mastodon-tl--property
+ 'notification-accounts :no-move)
+ collect (alist-get 'acct a)))
+ ;; mentions in item:
+ (mastodon-profile--extract-users-handles
+ (mastodon-profile--item-json))))
+ (t
+ (mastodon-profile--extract-users-handles
+ (mastodon-profile--item-json))))))
+ (mastodon-tl-read-handle-annotated
+ user-handles
+ (cond ((or ; TODO: make this "enable/disable notifications"
+ (string= action "disable")
+ (string= action "enable"))
+ (format "%s notifications when user posts: " action))
+ ((string-suffix-p "boosts" action)
+ (format "%s by user: " action))
+ (t (format "Handle of user to %s: " action)))))))
+
+(defun mastodon-tl--find-user (handle data)
+ "Find user with HANDLE in DATA."
+ (cl-find-if
+ (lambda (entry)
+ (string= handle (alist-get 'acct entry)))
+ data))
+
+(defun mastodon-tl--get-blocks-or-mutes-list (action)
+ "Fetch the list of accounts for ACTION from the server.
+Action must be either \"unblock\" or \"unmute\"."
+ (let* ((endpoint (cond ((string= action "unblock")
+ "blocks")
+ ((string= action "unmute")
+ "mutes")))
+ (url (mastodon-http--api endpoint))
+ (json (mastodon-http--get-json url))
+ (accts (mastodon-tl--map-alist 'acct json)))
+ (when accts
+ (completing-read (format "Handle of user to %s: " action)
+ accts nil :match))))
+
+(defun mastodon-tl--do-user-action-and-response
+ (user-handle action &optional negp notify langs reblogs json)
+ "Do ACTION on user USER-HANDLE.
+NEGP is whether the action involves un-doing something.
+If NOTIFY is \"true\", enable notifications when that user posts.
+If NOTIFY is \"false\", disable notifications when that user posts.
+NOTIFY is only non-nil when called by `mastodon-tl-follow-user'.
+LANGS is an array parameters alist of languages to filer user's posts by.
+REBLOGS is a boolean string like NOTIFY, enabling or disabling
+display of the user's boosts in your timeline."
+ (let* ((account
+ (cond
+ (negp ;; unmuting/unblocking, use mute/block list
+ (mastodon-profile--search-account-by-handle user-handle))
+ ;; (grouped) notifications:
+ ((member (mastodon-tl--get-buffer-type)
+ '(mentions notifications))
+ (let ((accounts (mastodon-tl--property 'notification-accounts)))
+ (or (cl-some (lambda (x)
+ (when (string= user-handle (alist-get 'acct x))
+ x))
+ accounts)
+ (mastodon-profile--lookup-account-in-status
+ user-handle
+ (mastodon-profile--item-json)))))
+ (t
+ (mastodon-profile--lookup-account-in-status
+ user-handle
+ (if (mastodon-tl--profile-buffer-p)
+ ;; profile view, use 'profile-json as status:
+ (mastodon-profile--profile-json)
+ ;; muting/blocking, select from handles in current status
+ (mastodon-profile--item-json))))))
+ (user-id (alist-get 'id account))
+ (name (mastodon-tl--display-or-uname account))
+ (args (cond (notify `(("notify" . ,notify)))
+ (langs langs)
+ (reblogs `(("reblogs" . ,reblogs)))
+ (t nil)))
+ (url (mastodon-http--api (format "accounts/%s/%s" user-id action))))
+ (if (not account)
+ (user-error "Cannot find a user with handle %S" user-handle)
+ (when (or (string= action "follow") ;; y-or-n for all but follow
+ (y-or-n-p (format "%s user %s? " action name)))
+ (mastodon-tl--do-user-action-function
+ url name user-handle action notify args reblogs json)))))
+
+(defun mastodon-tl--do-user-action-function
+ (url name user-handle action &optional notify args reblogs json)
+ "Post ACTION on user NAME/USER-HANDLE to URL.
+NOTIFY is either \"true\" or \"false\", and used when we have been called
+by `mastodon-tl-follow-user' to enable or disable notifications.
+ARGS is an alist of any parameters to send with the request."
+ (let ((response (mastodon-http--post url args nil nil json)))
+ (mastodon-http--triage
+ response
+ (lambda (response)
+ (let ((json (with-current-buffer response
+ (mastodon-http--process-json))))
+ ;; TODO: when > if, with failure msg
+ (cond ((string= notify "true")
+ (when (eq t (alist-get 'notifying json))
+ (message "Receiving notifications for user %s (@%s)!"
+ name user-handle)))
+ ((string= notify "false")
+ (when (eq :json-false (alist-get 'notifying json))
+ (message "Not receiving notifications for user %s (@%s)!"
+ name user-handle)))
+ ((string= reblogs "true")
+ (when (eq t (alist-get 'showing_reblogs json))
+ (message "Receiving boosts by user %s (@%s)!"
+ name user-handle)))
+ ((string= reblogs "false")
+ (when (eq :json-false (alist-get 'showing_reblogs json))
+ (message "Not receiving boosts by user %s (@%s)!"
+ name user-handle)))
+ ((or (string= action "mute")
+ (string= action "unmute"))
+ (message "User %s (@%s) %sd!" name user-handle action))
+ ((string= args "languages[]")
+ (message "User %s language filters removed!" name))
+ ((assoc "languages[]" args #'string=)
+ (message "User %s filtered by language(s): %s" name
+ (mapconcat #'cdr args " ")))
+ ((not (or notify reblogs))
+ (if (and (string= action "follow")
+ (eq t (alist-get 'requested json)))
+ (message "Follow requested for user %s (@%s)!" name user-handle)
+ (message "User %s (@%s) %sed!" name user-handle action)))))))))
+
+(defun mastodon-tl--get-domain-blocks ()
+ "Return a list of current domain blocks."
+ (mastodon-http--get-json
+ (mastodon-http--api "domain_blocks")))
+
+(defun mastodon-tl-block-domain ()
+ "Read a domain and block it."
+ (interactive)
+ (let* ((domain (read-string "Block domain: "))
+ (params `(("domain" . ,domain)))
+ (url (mastodon-http--api "domain_blocks"))
+ (resp (mastodon-http--post url params)))
+ (mastodon-http--triage
+ resp
+ (lambda (_)
+ (message "Domain blocked!")))))
+
+(defun mastodon-tl-unblock-domain ()
+ "Read a blocked domain and unblock it."
+ (interactive)
+ (let ((blocks (mastodon-tl--get-domain-blocks)))
+ (if (not blocks)
+ (user-error "No blocked domains?")
+ (let* ((domain (completing-read "Unblock domain: "
+ blocks))
+ (params `(("domain" . ,domain)))
+ (url (mastodon-http--api "domain_blocks"))
+ (resp (mastodon-http--delete url params)))
+ (mastodon-http--triage
+ resp
+ (lambda (_)
+ (message "Domain unblocked!")))))))
+
+\f
+;; FOLLOW TAGS
+
+(defun mastodon-tl--get-tags-list ()
+ "Return the list of tags of the toot at point."
+ (let* ((toot (mastodon-toot--base-toot-or-item-json))
+ (tags (mastodon-tl--field 'tags toot)))
+ (mastodon-tl--map-alist 'name tags)))
+
+(defun mastodon-tl-follow-tag (&optional tag)
+ "Prompt for a tag (from post at point) and follow it.
+If TAG provided, follow it."
+ (interactive)
+ (let* ((tags (unless tag (mastodon-tl--get-tags-list)))
+ (tag-at-point
+ (unless tag
+ (when (eq 'hashtag
+ (mastodon-tl--property 'mastodon-tab-stop :no-move))
+ (mastodon-tl--property 'mastodon-tag :no-move))))
+ (tag (or tag (completing-read
+ (format "Tag to follow [%s]: " tag-at-point)
+ tags nil nil nil nil tag-at-point)))
+ (url (mastodon-http--api (format "tags/%s/follow" tag)))
+ (response (mastodon-http--post url)))
+ (mastodon-http--triage response
+ (lambda (_)
+ (message "tag #%s followed!" tag)))))
+
+(defun mastodon-tl--followed-tags ()
+ "Return JSON of tags followed."
+ (let ((url (mastodon-http--api (format "followed_tags"))))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl-unfollow-tag (&optional tag)
+ "Prompt for a followed tag, and unfollow it.
+If TAG is provided, unfollow it."
+ (interactive)
+ (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags)))
+ (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)))
+ (response (mastodon-http--post url)))
+ (mastodon-http--triage response
+ (lambda (_)
+ (message "tag #%s unfollowed!" tag)))))
+
+(defun mastodon-tl-jump-to-followed-tag (&optional prefix)
+ "Prompt for a followed tag and view its timeline.
+PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
+ (interactive "p")
+ (let* ((followed-tags-json (mastodon-tl--followed-tags))
+ (tags (mastodon-tl--map-alist 'name followed-tags-json))
+ (tag (completing-read "Tag: " tags nil)))
+ (if (null tag)
+ (user-error "You have to follow some tags first")
+ (mastodon-tl-get-tag-timeline prefix tag))))
+
+(defun mastodon-tl-list-followed-tags ()
+ "List followed tags. View timeline of tag user choses.
+PREFIX is sent to `mastodon-tl-get-tag-timeline', which see."
+ (interactive)
+ (let* ((json (mastodon-tl--followed-tags))
+ (sorted (cl-sort json #'string-lessp
+ :key (lambda (x)
+ (downcase (alist-get 'name x)))))
+ (buf "*mastodon-followed-tags*"))
+ (if (null sorted)
+ (user-error "You have to follow some tags first")
+ (with-mastodon-buffer (get-buffer-create buf)
+ #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec
+ buf "followed_tags" #'mastodon-tl-list-followed-tags)
+ (mastodon-search--insert-heading "followed tags")
+ (insert "\n")
+ (mastodon-search--print-tags sorted)
+ (goto-char (point-min))))))
+
+(defun mastodon-tl-followed-tags-timeline (&optional prefix)
+ "Open a timeline of multiple tags.
+With a single PREFIX arg, only show posts with media.
+With a double PREFIX arg, limit results to your own instance.
+If `mastodon-tl--tag-timeline-tags' is set, use its tags, else
+fetch followed tags and load the first four of them."
+ (interactive "p")
+ (let* ((followed-tags-json (mastodon-tl--followed-tags))
+ (tags (or mastodon-tl--tag-timeline-tags
+ (mastodon-tl--map-alist 'name followed-tags-json))))
+ (mastodon-tl--show-tag-timeline prefix tags)))
+
+(defun mastodon-tl-some-followed-tags-timeline (&optional prefix)
+ "Prompt for some tags, and open a timeline for them.
+The suggestions are from followed tags, but any other tags are also allowed.
+PREFIX is for `mastodon-tl--show-tag-timeline', which see."
+ (interactive "p")
+ (let* ((followed-tags-json (mastodon-tl--followed-tags))
+ (tags (mastodon-tl--map-alist 'name followed-tags-json))
+ (selection (completing-read-multiple
+ "Tags' timelines to view [TAB to view, comma to separate]: "
+ tags)))
+ (mastodon-tl--show-tag-timeline prefix selection)))
+
+(defcustom mastodon-tl--tags-groups nil
+ "A list containing lists of up to four tags each.
+You can load a tag timeline list with one of these by calling
+`mastodon-tl-tag-group-timeline'."
+ :group 'mastodon-tl
+ :type '(repeat (list string string string string)))
+
+(defun mastodon-tl-tag-group-timeline (&optional prefix)
+ "Load a timeline of a tag group from `mastodon-tl--tags-groups'.
+PREFIX is for `mastodon-tl--show-tag-timeline', which see."
+ (interactive "P")
+ (if (not mastodon-tl--tags-groups)
+ (user-error
+ "Set `mastodon-tl--tags-groups' to view tag group timelines")
+ (let* ((list-strs (mapcar (lambda (x)
+ ;; cons of list-as-string and list:
+ (cons (prin1-to-string x) x))
+ mastodon-tl--tags-groups))
+ (choice (completing-read "Tag group: " list-strs))
+ (choice-list (cdr (assoc choice list-strs #'equal))))
+ (mastodon-tl--show-tag-timeline prefix choice-list))))
+
+\f
+;;; REPORT TO MODERATORS
+
+(defun mastodon-tl--instance-rules ()
+ "Return the rules of the user's instance."
+ (let ((url (mastodon-http--api "instance/rules")))
+ (mastodon-http--get-json url nil :silent)))
+
+(defun mastodon-tl--report-params (account toot)
+ "Query user and return report params alist.
+ACCOUNT and TOOT are the data to use."
+ (let* ((account-id (alist-get 'id account))
+ (comment (read-string "Add comment [optional]: "))
+ (item-id (when (y-or-n-p "Also report status at point? ")
+ (mastodon-tl--item-id toot))) ; base toot if poss
+ (forward-p (when (y-or-n-p "Forward to remote admin? ") "true"))
+ (rules (when (y-or-n-p "Cite a rule broken? ")
+ (mastodon-tl--read-rules-ids)))
+ (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other"))))
+ (mastodon-tl--report-build-params account-id comment item-id
+ forward-p cat rules)))
+
+(defun mastodon-tl--report-build-params
+ (account-id comment item-id forward-p cat &optional rules)
+ "Build the parameters alist based on user responses.
+ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from
+`mastodon-tl--report-params', which see."
+ (let ((params
+ `(("account_id" . ,account-id)
+ ,@(when comment `(("comment" . ,comment)))
+ ,@(when item-id `(("status_ids[]" . ,item-id)))
+ ,@(when forward-p `(("forward" . ,forward-p)))
+ ,@(when cat `(("category" . ,cat))))))
+ (if (not rules)
+ params
+ (let ((alist
+ (mastodon-http--build-array-params-alist "rule_ids[]" rules)))
+ (append alist params)))))
+
+(defun mastodon-tl-report-to-mods ()
+ "Report the author of the toot at point to your instance moderators.
+Optionally report the toot at point, add a comment, cite rules
+that have been broken, forward the report to the remove admin,
+report the account for spam."
+ (interactive)
+ (mastodon-tl--do-if-item
+ (when (y-or-n-p "Report author of toot at point?")
+ (let* ((url (mastodon-http--api "reports"))
+ (toot (mastodon-tl--toot-or-base
+ (mastodon-tl--property 'item-json :no-move)))
+ (account (alist-get 'account toot))
+ (handle (alist-get 'acct account))
+ (params (mastodon-tl--report-params account toot))
+ (response (mastodon-http--post url params)))
+ (mastodon-http--triage response
+ (lambda (_)
+ (message "User %s reported!" handle)))))))
+
+(defvar crm-separator)
+
+(defun mastodon-tl--map-rules-alist (rules)
+ "Convert RULES text and id fields into an alist."
+ (mastodon-tl--map-alist-vals-to-alist 'text 'id rules))
+
+(defun mastodon-tl--read-rules-ids ()
+ "Prompt for a list of instance rules and return a list of selected ids."
+ (let* ((rules (mastodon-tl--instance-rules))
+ (alist (mastodon-tl--map-rules-alist rules))
+ (crm-separator (replace-regexp-in-string "," "|" crm-separator))
+ (choices (completing-read-multiple
+ "rules [TAB for options, | to separate]: "
+ alist nil t)))
+ (mapcar (lambda (x)
+ (alist-get x alist nil nil #'string=))
+ choices)))
+
+\f
+;;; UPDATING, etc.
+
+(defun mastodon-tl--no-json (json)
+ "Nil if JSON is nil or empty group notif data."
+ (if (and (mastodon-tl--buffer-type-eq 'notifications)
+ mastodon-group-notifications)
+ (mastodon-notifications--empty-group-json-p json)
+ (not json)))
+
+(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 silent 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.
+Optionally make the request SILENT."
+ (let* ((args `(("max_id" . ,(mastodon-tl--as-string id))))
+ (args (append args params))
+ (url (mastodon-http--api
+ endpoint
+ (when (or (and mastodon-group-notifications
+ (string= endpoint "notifications"))
+ (string-suffix-p "search" endpoint))
+ "v2"))))
+ (apply #'mastodon-http--get-json-async url args silent callback cbargs)))
+
+(defun mastodon-tl--more-json-async-offset (endpoint &optional params silent
+ callback &rest cbargs)
+ "Return JSON for ENDPOINT, using the \"offset\" query param.
+This is used for pagination with endpoints that implement the
+\"offset\" parameter, rather than using link-headers or
+\"max_id\".
+PARAMS are the update parameters, see
+`mastodon-tl--update-params'. These (\"limit\" and \"offset\")
+must be set in `mastodon-tl--buffer-spec' for pagination to work.
+Then run CALLBACK with arguments CBARGS.
+Optionally make the request SILENT."
+ (let* ((params (or params (mastodon-tl--update-params)))
+ (limit (string-to-number
+ (alist-get "limit" params nil nil #'string=)))
+ (offset (number-to-string
+ (+ limit ; limit + old offset = new offset
+ (string-to-number
+ (alist-get "offset" params nil nil #'string=)))))
+ (url (mastodon-http--api
+ endpoint
+ (when (string-suffix-p "search" endpoint)
+ "v2"))))
+ ;; increment:
+ (setf (alist-get "offset" params nil nil #'string=) offset)
+ (apply #'mastodon-http--get-json-async url params silent 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.
+VERSION is the API version to use, as grouped notifs use v2."
+ (let* ((args `(("since_id" . ,(mastodon-tl--as-string id))))
+ (args (append args params))
+ (url (mastodon-http--api
+ endpoint
+ (when (and mastodon-group-notifications
+ (string= endpoint "notifications"))
+ "v2"))))
+ (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 (&optional pos)
+ "Reload the current timeline or profile page.
+For use after e.g. deleting a toot.
+POS is a number, where point will be placed.
+Aims to respect any pagination in effect."
+ (let ((type (mastodon-tl--get-buffer-type))
+ (max-id (mastodon-tl--buffer-property 'max-id nil :no-error)))
+ (cond ((eq type 'home)
+ (mastodon-tl-get-home-timeline nil max-id))
+ ((eq type 'federated)
+ (mastodon-tl-get-federated-timeline nil nil max-id))
+ ((eq type 'local)
+ (mastodon-tl-get-local-timeline nil max-id))
+ ((eq type 'mentions)
+ (mastodon-notifications-get-mentions))
+ ((eq type 'notifications)
+ (mastodon-notifications-get nil nil max-id))
+ ((eq type 'profile-statuses-no-boosts)
+ ;; TODO: max-id arg needed here also
+ (mastodon-profile-open-statuses-no-reblogs))
+ ((eq type 'profile-statuses)
+ (save-excursion
+ (goto-char (point-min))
+ (mastodon-profile--make-author-buffer
+ ;; (mastodon-profile-get-toot-author max-id)))
+ (mastodon-profile--profile-json))))
+ ((or (eq type 'single-status)
+ (eq type 'thread))
+ (let ((id (mastodon-tl--buffer-property
+ 'thread-item-id (current-buffer) :no-error)))
+ (mastodon-tl--thread-do id))))
+ ;; TODO: sends point to where point was in buffer. This is very rough; we
+ ;; may have removed an item , so the buffer will be smaller, point will
+ ;; end up past where we were, etc.
+ (when pos
+ (goto-char pos)
+ (mastodon-tl-goto-prev-item :no-refresh))))
+
+(defun mastodon-tl--build-link-header-url (str)
+ "Return a URL from STR, an http Link header."
+ (let* ((split (split-string str "; "))
+ (url-base (string-trim (car split) "<" ">"))
+ (param (cadr split)))
+ (concat url-base "&" param)))
+
+(defun mastodon-tl--use-link-header-p ()
+ "Return t if we are in a view needing Link header pagination.
+Currently this includes favourites, bookmarks, follow requests,
+and profile pages when showing followers or accounts followed."
+ (or (mastodon-tl--buffer-type-eq 'favourites)
+ (mastodon-tl--buffer-type-eq 'bookmarks)
+ (mastodon-tl--buffer-type-eq 'profile-followers)
+ (mastodon-tl--buffer-type-eq 'profile-following)
+ (mastodon-tl--buffer-type-eq 'follow-requests)))
+
+(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."
+ (message "Loading...")
+ (if (mastodon-tl--use-link-header-p)
+ ;; link-header paginate:
+ ;; can't build a URL with --more-json-async, endpoint/id:
+ ;; ensure we have a "next" type here, otherwise the CAR will be the
+ ;; "prev" type!
+ (let ((link-header (mastodon-tl--link-header)))
+ (if (> 2 (length link-header))
+ (user-error "No next page")
+ (let* ((next (car link-header))
+ ;;(prev (cadr (mastodon-tl--link-header)))
+ (url (mastodon-tl--build-link-header-url next)))
+ (mastodon-http--get-response-async
+ url nil nil 'mastodon-tl--more* (current-buffer) (point) :headers))))
+ (cond (;; no paginate
+ (or (mastodon-tl--buffer-type-eq 'follow-suggestions)
+ (mastodon-tl--buffer-type-eq 'filters)
+ (mastodon-tl--buffer-type-eq 'lists))
+ (user-error "No more results"))
+ ;; offset paginate (search, trending, user lists, ...?):
+ ((or (string-prefix-p "*mastodon-trending-" (buffer-name))
+ (mastodon-tl--search-buffer-p))
+ (mastodon-tl--more-json-async-offset
+ (mastodon-tl--endpoint)
+ (mastodon-tl--update-params) nil
+ 'mastodon-tl--more* (current-buffer) (point)))
+ (t ;; max_id paginate (timelines, items with ids/timestamps):
+ (let ((max-id (mastodon-tl--oldest-id))
+ (params (mastodon-tl--update-params)))
+ (mastodon-tl--more-json-async
+ (mastodon-tl--endpoint)
+ max-id params nil
+ 'mastodon-tl--more*
+ (current-buffer) (point) nil max-id))))))
+
+(defun mastodon-tl--more*
+ (response buffer point-before &optional headers max-id)
+ "Append older toots to timeline, asynchronously.
+Runs the timeline's update function on RESPONSE, in BUFFER.
+When done, places point at POINT-BEFORE.
+HEADERS is the http headers returned in the response, if any.
+MAX-ID is the pagination parameter, a string.
+UPDATE-PARAMS is from prev buffer spec, added to the new one."
+ (with-current-buffer buffer
+ (if (not response)
+ (user-error "No more results")
+ (let* ((inhibit-read-only t)
+ (json (if headers (car response) response))
+ ;; FIXME: max-id pagination works for statuses only, not other
+ ;; search results pages:
+ (json (if (not (mastodon-tl--search-buffer-p))
+ json
+ (let ((type (mastodon-search--buf-type)))
+ (cond ((string= "statuses" type)
+ (cdr ; avoid repeat of last status
+ (alist-get 'statuses response)))
+ ((string= "hashtags" type)
+ (alist-get 'hashtags response))
+ ((string= "accounts" type)
+ (alist-get 'accounts response))))))
+ (headers (when headers (cdr response)))
+ (link-header
+ (mastodon-tl--get-link-header-from-response headers))
+ (buf-type (mastodon-tl--get-buffer-type))
+ (notifs-p (or (eq buf-type 'notifications)
+ (eq buf-type 'mentions)))
+ (notif-type (when notifs-p
+ (mastodon-notifications--current-type))))
+ (goto-char (point-max))
+ (if (eq 'thread buf-type)
+ ;; if thread fully unfolded, respect it:
+ ;; if thread view, call --thread-do with parent ID
+ (progn (goto-char (point-min))
+ (mastodon-tl-goto-next-item)
+ (mastodon-tl--thread-do)
+ (goto-char point-before)
+ (message "Loaded full thread."))
+ (if (mastodon-tl--no-json json)
+ (user-error "No more results")
+ (if notifs-p
+ (mastodon-notifications--timeline json notif-type :update)
+ (funcall (mastodon-tl--update-function) json))
+ (goto-char point-before)
+ ;; update buffer spec to new link-header or max-id:
+ ;; (other values should just remain as they were)
+ (mastodon-tl--set-buffer-spec
+ (mastodon-tl--buffer-name)
+ (mastodon-tl--endpoint)
+ (mastodon-tl--update-function)
+ link-header (mastodon-tl--update-params)
+ (mastodon-tl--hide-replies-p) max-id)
+ (message "Loading... done.")))))))
+
+(defun mastodon-tl--find-property-range (property start-point
+ &optional search-backwards)
+ "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)
+ ;; We are within a range, so look backwards for the start:
+ (cons (previous-single-property-change
+ (if (eq start-point (point-max)) start-point (1+ start-point))
+ property nil (point-min))
+ (next-single-property-change start-point property nil (point-max)))
+ (if search-backwards
+ (let* ((end (or (previous-single-property-change
+ (if (eq start-point (point-max))
+ start-point
+ (1+ start-point))
+ property)
+ ;; we may either be just before the range or there
+ ;; is nothing at all
+ (and (not (eq start-point (point-min)))
+ (get-text-property (1- start-point) property)
+ start-point)))
+ (start (and end (previous-single-property-change
+ end property nil (point-min)))))
+ (when end
+ (cons start end)))
+ (let* ((start (next-single-property-change start-point property))
+ (end (and start (next-single-property-change
+ start property nil (point-max)))))
+ (when start
+ (cons start end))))))
+
+(defun mastodon-tl--find-next-or-previous-property-range
+ (property start-point search-backwards)
+ "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 (not (get-text-property start-point property))
+ ;; If we are not within a range, we can just defer to
+ ;; mastodon-tl--find-property-range directly.
+ (mastodon-tl--find-property-range property start-point search-backwards)
+ ;; We are within a range, we need to start the search from
+ ;; before/after this range:
+ (let ((current-range
+ (mastodon-tl--find-property-range property start-point)))
+ (if search-backwards
+ (unless (eq (car current-range) (point-min))
+ (mastodon-tl--find-property-range
+ property (1- (car current-range)) search-backwards))
+ (unless (eq (cdr current-range) (point-max))
+ (mastodon-tl--find-property-range
+ property (1+ (cdr current-range)) search-backwards))))))
+
+(defun mastodon-tl--consider-timestamp-for-updates (timestamp)
+ "Take note that TIMESTAMP is used in buffer and ajust timers as needed.
+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 (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
+ (time-subtract mastodon-tl--timestamp-next-update
+ (seconds-to-time 10)))
+ (setq mastodon-tl--timestamp-next-update this-update)
+ (when mastodon-tl--timestamp-update-timer
+ ;; We need to re-schedule for an earlier time
+ (cancel-timer mastodon-tl--timestamp-update-timer)
+ (setq mastodon-tl--timestamp-update-timer
+ (run-at-time (time-to-seconds (time-subtract this-update
+ (current-time)))
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer) nil)))))))
+
+(defun mastodon-tl--update-timestamps-callback (buffer previous-marker)
+ "Update the next few timestamp displays in BUFFER.
+Start searching for more timestamps from PREVIOUS-MARKER or
+from the start if it is nil."
+ ;; only do things if the buffer hasn't been killed in the meantime
+ (when (and mastodon-tl--enable-relative-timestamps ; just in case
+ (buffer-live-p buffer))
+ (save-excursion
+ (with-current-buffer buffer
+ (let ((previous-timestamp (if previous-marker
+ (marker-position previous-marker)
+ (point-min)))
+ (iteration 0)
+ next-timestamp-range)
+ (if previous-marker
+ ;; a follow-up call to process the next batch of timestamps.
+ ;; Release the marker to not slow things down.
+ (set-marker previous-marker nil)
+ ;; Otherwise this is a rew run, so let's initialize the next-run time.
+ (setq mastodon-tl--timestamp-next-update (time-add (current-time)
+ (seconds-to-time 300))
+ mastodon-tl--timestamp-update-timer nil))
+ (while (and (< iteration 5)
+ (setq next-timestamp-range
+ (mastodon-tl--find-property-range 'timestamp
+ previous-timestamp)))
+ (let* ((start (car next-timestamp-range))
+ (end (cdr next-timestamp-range))
+ (timestamp (get-text-property start 'timestamp))
+ (current-display (get-text-property start 'display))
+ (new-display (mastodon-tl--relative-time-description timestamp)))
+ (unless (string= current-display new-display)
+ (let ((inhibit-read-only t))
+ (add-text-properties
+ start end
+ (list 'display
+ (mastodon-tl--relative-time-description timestamp)))))
+ (mastodon-tl--consider-timestamp-for-updates timestamp)
+ (setq iteration (1+ iteration)
+ previous-timestamp (1+ (cdr next-timestamp-range)))))
+ (if next-timestamp-range
+ ;; schedule the next batch from the previous location to
+ ;; start very soon in the future:
+ (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer
+ (copy-marker previous-timestamp))
+ ;; otherwise we are done for now; schedule a new run for when needed
+ (setq mastodon-tl--timestamp-update-timer
+ (run-at-time (time-to-seconds
+ (time-subtract mastodon-tl--timestamp-next-update
+ (current-time)))
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ buffer nil))))))))
+
+(defun mastodon-tl--set-after-update-marker ()
+ "Set `mastodon-tl--after-update-marker' to the after-update location.
+This location is defined by a non-nil value of
+`mastodon-tl-position-after-update'."
+ (if (not mastodon-tl-position-after-update)
+ (setq mastodon-tl--after-update-marker nil)
+ (let ((marker (make-marker)))
+ (set-marker marker
+ (cond
+ ((eq 'keep-point mastodon-tl-position-after-update)
+ (point))
+ ((eq 'last-old-toot mastodon-tl-position-after-update)
+ (next-single-property-change
+ (or mastodon-tl--update-point (point-min))
+ 'byline))
+ (t
+ (error "Unknown mastodon-tl-position-after-update value %S"
+ mastodon-tl-position-after-update))))
+ ;; Make the marker advance if text gets inserted there.
+ (set-marker-insertion-type marker t)
+ (setq mastodon-tl--after-update-marker marker))))
+
+(defun mastodon-tl-update ()
+ "Update timeline with new toots."
+ (interactive)
+ ;; FIXME: actually these buffers should just reload by calling their own
+ ;; load function (actually g is mostly mapped as such)
+ ;; well actually, g should be for reload, update is different.
+ (if (or (member (mastodon-tl--get-buffer-type)
+ '(trending-statuses
+ trending-tags
+ follow-suggestions
+ lists
+ filters
+ scheduled-statuses))
+ (mastodon-tl--search-buffer-p))
+ (user-error "Update not available in this view")
+ ;; FIXME: handle update for search and trending buffers
+ (let* ((endpoint (mastodon-tl--endpoint))
+ (update-fun (mastodon-tl--update-function))
+ (id (mastodon-tl--newest-id)))
+ ;; update a thread, without calling `mastodon-tl--updated-json':
+ (if (mastodon-tl--buffer-type-eq 'thread)
+ ;; load whole thread:
+ (progn (mastodon-tl--thread-do id)
+ (message "Loaded full thread."))
+ (if (not id) ;; if e.g. notifs all cleared:
+ (user-error "No last id")
+ ;; update other timelines:
+ (let* ((params (mastodon-tl--update-params))
+ (notifs-p
+ (eq update-fun 'mastodon-notifications--timeline))
+ (json (mastodon-tl--updated-json
+ endpoint id params)))
+ (if (mastodon-tl--no-json json)
+ (user-error "Nothing to update")
+ (let ((inhibit-read-only t))
+ (mastodon-tl--set-after-update-marker)
+ (goto-char (or mastodon-tl--update-point (point-min)))
+ (if notifs-p
+ (funcall update-fun json nil :update)
+ (funcall update-fun json))
+ (if mastodon-tl--after-update-marker
+ (goto-char mastodon-tl--after-update-marker)
+ (mastodon-tl-goto-next-item))))))))))
+
+\f
+;;; LOADING TIMELINES
+
+(defun mastodon-tl--init
+ (buffer-name endpoint update-function &optional headers params
+ hide-replies instance no-byline)
+ "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously.
+UPDATE-FUNCTION is used to recieve more toots.
+HEADERS means to also collect the response headers. Used for paginating
+favourites and bookmarks.
+PARAMS is any parameters to send with the request.
+HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer.
+INSTANCE is a string of another instance domain we are displaying
+a timeline from.
+NO-BYLINE means just insert toot body, used for announcements."
+ (let ((url (if instance
+ (concat "https://" instance "/api/v1/" endpoint)
+ (mastodon-http--api endpoint)))
+ (buffer (concat "*mastodon-" buffer-name "*")))
+ (funcall
+ (if headers
+ #'mastodon-http--get-response-async
+ #'mastodon-http--get-json-async)
+ url params nil ;; not silent
+ 'mastodon-tl--init*
+ buffer endpoint update-function headers params hide-replies
+ instance no-byline)))
+
+(defun mastodon-tl--init*
+ (response buffer endpoint update-function &optional headers
+ update-params hide-replies instance no-byline)
+ "Initialize BUFFER with timeline targeted by ENDPOINT.
+UPDATE-FUNCTION is used to recieve more toots.
+RESPONSE is the data returned from the server by
+`mastodon-http--process-json', with arg HEADERS a cons cell of
+JSON and http headers, without it just the JSON.
+NO-BYLINE means just insert toot body, used for announcements."
+ (let ((json (if headers (car response) response)))
+ (cond ((not json) ; praying this is right here, else try "\n[]"
+ ;; this means that whatever tl was inited won't load, which is not
+ ;; always wanted, as sometimes you still need the page to load so
+ ;; you can be in eg mastodon-mode, have keymap, search etc.
+ (message "Looks like nothing returned from endpoint: %s" endpoint)
+ ;; if we are a new account, home tl may have nothing, but then
+ ;; this clause means we can never load mastodon.el at all!
+ ;; so as a fallback, load trending statuses:
+ ;; FIXME: this could possibly be a fallback for all timelines not
+ ;; just home?
+ (when (string= endpoint "timelines/home")
+ (mastodon-search-trending-statuses)))
+ ((eq (caar json) 'error)
+ (user-error "Looks like the server bugged out: \"%s\"" (cdar json)))
+ (t
+ (let* ((headers (when headers (cdr response)))
+ (link-header
+ (mastodon-tl--get-link-header-from-response headers)))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ (mastodon-tl--set-buffer-spec
+ buffer endpoint update-function
+ link-header update-params hide-replies
+ ;; awful hack to fix multiple reloads:
+ (alist-get "max_id" update-params nil nil #'string=))
+ (mastodon-tl--do-init json update-function instance no-byline)))))))
+
+(defun mastodon-tl--init-sync
+ (buffer-name endpoint update-function &optional note-type params
+ headers view-name binding-str endpoint-version)
+ "Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
+UPDATE-FUNCTION is used to receive more toots.
+Runs synchronously.
+Optional arg NOTE-TYPE means only get that type of notification.
+PARAMS is an alist of any params to include in the request.
+HEADERS are any headers to send in the request.
+VIEW-NAME is a string, to be used as a heading for the view.
+BINDING-STR is a string explaining any bindins in the view, it can have
+formatting for `substitute-command-keys'.
+ENDPOINT-VERSION is a string, format Vx, e.g. V2."
+ ;; Used by `mastodon-notifications-get' and in views.el
+ (let* ((notes-params (when note-type
+ (mastodon-http--build-array-params-alist
+ "types[]" (list note-type))))
+ (params (append notes-params params))
+ (url (mastodon-http--api endpoint endpoint-version))
+ (buffer (concat "*mastodon-" buffer-name "*"))
+ (response (mastodon-http--get-response url params))
+ (json (car response))
+ (headers (when headers (cdr response)))
+ (link-header (when headers
+ (mastodon-tl--get-link-header-from-response headers))))
+ (with-mastodon-buffer buffer #'mastodon-mode nil
+ ;; insert view-name/ heading-str
+ (when view-name
+ (mastodon-search--insert-heading view-name))
+ (when binding-str
+ (insert
+ (substitute-command-keys
+ (mastodon-tl--set-face (concat "[" binding-str "]\n\n")
+ 'mastodon-toot-docs-face))))
+ (mastodon-tl--set-buffer-spec
+ buffer endpoint update-function
+ link-header params nil
+ ;; awful hack to fix multiple reloads:
+ (alist-get "max_id" params nil nil #'string=))
+ (mastodon-tl--do-init json update-function nil nil note-type)
+ buffer)))
+
+(defun mastodon-tl--do-init (json update-fun &optional domain no-byline type)
+ "Utility function for `mastodon-tl--init*' and `mastodon-tl--init-sync'.
+JSON is the data to call UPDATE-FUN on.
+When DOMAIN, force inclusion of user's domain in their handle.
+NO-BYLINE means just insert toot body, used for announcements.
+TYPE is a notification type."
+ (remove-overlays) ; video overlays
+ (cond (domain ;; maybe our update-fun doesn't always have 3 args...:
+ (funcall update-fun json nil domain))
+ (type (funcall update-fun json type)) ;; notif types
+ (no-byline (funcall update-fun json nil nil no-byline))
+ (t (funcall update-fun json)))
+ (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)))
+ (setq mastodon-tl--timestamp-update-timer
+ (when mastodon-tl--enable-relative-timestamps
+ (run-at-time (time-to-seconds
+ (time-subtract mastodon-tl--timestamp-next-update
+ (current-time)))
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer)
+ nil)))
+ (unless (mastodon-tl--profile-buffer-p)
+ (mastodon-tl--goto-first-item)))
+
+;;; NODEINFO
+
+(defun mastodon-tl--get-nodeinfo (instance &optional version)
+ "Return Nodeinfo data for INSTANCE, optionally for VERSION."
+ ;; NB: not in the API:
+ (let ((url (format "https://%s/nodeinfo/%s" instance (or version "2.0"))))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-tl-nodeinfo-for-toot ()
+ "Return Nodeinfo for toot at point.
+Displays what software and version an instance is running.
+Also the instances description and usage stats, etc.
+Nodeinfo is a data standard for distributed social networks, see
+https://nodeinfo.diaspora.software."
+ (interactive)
+ (let* ((item (mastodon-tl--property 'item-json))
+ (url (mastodon-tl--field 'url item))
+ (instance (url-host (url-generic-parse-url url)))
+ (data (mastodon-tl--get-nodeinfo instance)))
+ (when data ;; don't display empty message when fetching failed
+ (if (eq 'error (caar data))
+ (user-error "Error: %s" (alist-get 'error data))
+ (mastodon-tl--render-nodeinfo data)))))
+
+(defun mastodon-tl--render-nodeinfo (data)
+ "Render Nodeinfo DATA as message."
+ (let-alist data
+ (message
+ "%s"
+ (concat "Software: "
+ .software.name " " .software.version
+ (if (not .metadata)
+ ""
+ (concat
+ "\nInstance: "
+ .metadata.nodeName " " .metadata.nodeDescription))))))
+
+;;; BOOKMARKS
+
+(require 'bookmark)
+
+(defun mastodon-tl--bookmark-handler (record)
+ "Jump to a bookmarked location in mastodon.el.
+RECORD is the bookmark record."
+ (let ((id (bookmark-prop-get record 'id)))
+ ;; we need to handle thread and single toot for starters
+ (pop-to-buffer
+ (mastodon-tl--thread-do id))))
+
+(defun mastodon-tl--bookmark-make-record ()
+ "Return a bookmark record for the current mastodon buffer."
+ (let ((id (mastodon-tl--property 'item-id :no-move))
+ (name (buffer-name)))
+ `(,name
+ (buf . ,name)
+ (id . ,id)
+ (handler . mastodon-tl--bookmark-handler))))
+
+(add-hook 'mastodon-mode-hook
+ (lambda ()
+ (setq-local bookmark-make-record-function
+ #'mastodon-tl--bookmark-make-record)))
+
+(provide 'mastodon-tl)
+;;; mastodon-tl.el ends here
--- /dev/null
+;;; mastodon-toot.el --- Minor mode for sending Mastodon toots -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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-toot.el supports POSTing status data to Mastodon.
+
+;;; Code:
+(eval-when-compile (require 'subr-x))
+
+(defvar mastodon-use-emojify)
+(require 'emojify nil :noerror)
+(declare-function emojify-insert-emoji "emojify")
+(declare-function emojify-set-emoji-data "emojify")
+(declare-function emojify-mode "emojify")
+(declare-function emojify-emojis-each "emojify")
+(defvar emojify-emojis-dir)
+(defvar emojify-user-emojis)
+(defvar emojify-emoji-styles)
+
+(require 'cl-lib)
+(require 'persist)
+(require 'mastodon-iso)
+(require 'facemenu)
+(require 'text-property-search)
+
+(eval-when-compile
+ (require 'mastodon-tl))
+
+(defvar mastodon-instance-url)
+(defvar mastodon-tl--buffer-spec)
+(defvar mastodon-tl--enable-proportional-fonts)
+(defvar mastodon-profile-account-settings)
+(defvar mastodon-profile-acccount-preferences-data)
+(defvar mastodon-profiles-quote-policy-types)
+
+(autoload 'iso8601-parse "iso8601")
+(autoload 'ht-get "ht")
+(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-kill-window "mastodon")
+(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--field "mastodon-tl")
+(autoload 'mastodon-tl--find-property-range "mastodon-tl")
+(autoload 'mastodon-tl--find-property-range "mastodon-tl")
+(autoload 'mastodon-tl-goto-next-item "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--render-text "mastodon-tl")
+(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl")
+(autoload 'mastodon-tl--symbol "mastodon-tl")
+(autoload 'mastodon-tl--item-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 'mastodon-tl--toot-or-base "mastodon-tl")
+(autoload 'mastodon-profile--get-source-value "mastodon-toot")
+(autoload 'mastodon-tl--get-buffer-type "mastodon-tl")
+(autoload 'mastodon-tl--human-duration "mastodon-tl")
+(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile")
+(autoload 'mastodon-views--get-own-instance "mastodon-views")
+(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
+(autoload 'mastodon-instance-data "mastodon")
+(autoload 'mastodon-create-poll "mastodon-transient")
+(autoload 'mastodon-tl--own-profile-buffer-p "mastodon-tl")
+(autoload 'mastodon-tl--thread-do "mastodon-tl")
+
+;; 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-"
+ :group 'mastodon)
+
+(defcustom mastodon-toot--default-media-directory "~/"
+ "The default directory when prompting for a media file to upload."
+ :type 'string)
+
+(defcustom mastodon-toot--attachment-height 80
+ "Height of the attached images preview in the toot draft buffer."
+ :type 'integer)
+
+(defcustom mastodon-toot--enable-completion t
+ "Whether to enable completion of mentions and hashtags.
+Used for completion in toot compose buffer."
+ :type 'boolean)
+
+(defcustom mastodon-toot--use-company-for-completion nil
+ "Whether to enable company for completion.
+When non-nil, `company-mode' is enabled in the toot compose
+buffer, and mastodon completion backends are added to
+`company-capf'.
+
+You need to install company yourself to use this."
+ :type 'boolean)
+
+(defcustom mastodon-toot--completion-style-for-mentions "all"
+ "The company completion style to use for mentions."
+ :type '(choice
+ (const :tag "off" nil)
+ (const :tag "following only" "following")
+ (const :tag "all users" "all")))
+
+(defcustom mastodon-toot-display-orig-in-reply-buffer nil
+ "Display a copy of the toot replied to in the compose buffer."
+ :type 'boolean)
+
+(defcustom mastodon-toot-orig-in-reply-length 191
+ ;; three lines of divider width: (- (* 3 67) (length " Reply to: "))
+ "Length to crop toot replied to in the compose buffer to."
+ :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."
+ :type '(choice
+ (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."
+ :type 'boolean)
+
+(defcustom mastodon-toot--proportional-fonts-compose nil
+ "Nonnil to enable using proportional fonts in the compose buffer.
+By default fixed width fonts are used."
+ :type '(boolean :tag "Enable using proportional rather than fixed \
+width fonts"))
+
+(defcustom mastodon-toot-poll-use-transient t
+ "Whether to use the transient menu to create a poll."
+ :type '(boolean))
+
+(defvar-local mastodon-toot--content-warning nil
+ "The content warning of the current toot.")
+
+(defvar-local mastodon-toot--content-nsfw nil
+ "A flag indicating whether the toot should be marked as NSFW.")
+
+(defvar mastodon-toot-visibility-list
+ '(public unlisted private direct)
+ "A list of the available toot visibility settings.")
+
+(defvar mastodon-toot-visibility-settings-list
+ '("public" "unlisted" "private")
+ "A list of the available default toot visibility settings.
+Like `mastodon-toot-visibility-list' but without direct.")
+
+(defvar-local mastodon-toot--visibility nil
+ "A string indicating the visibility of the toot being composed.
+Valid values are \"direct\", \"private\" (followers-only),
+\"unlisted\", and \"public\".
+
+This is determined by the account setting on the server. To
+change the setting on the server, see
+`mastodon-toot-set-default-visibility'.")
+
+(defvar-local mastodon-toot--media-attachments nil
+ "A list of the media attachments of the toot being composed.")
+
+(defvar-local mastodon-toot--media-attachment-ids nil
+ "A list of any media attachment ids of the toot being composed.")
+
+(defvar mastodon-toot-poll nil
+ "A plist of poll options for the toot being composed.")
+
+(defvar-local mastodon-toot--language nil
+ "The language of the toot being composed, in ISO 639 (two-letter).")
+
+(defvar-local mastodon-toot--scheduled-for nil
+ "An ISO 8601 timestamp that specifying when the post should be published.
+Should be at least 5 minutes into the future.")
+
+(defvar-local mastodon-toot--scheduled-id nil
+ "The id of the scheduled post that we are now editing.")
+
+(defvar-local mastodon-toot--reply-to-id nil
+ "Buffer-local variable to hold the id of the toot being replied to.")
+
+(defvar-local mastodon-toot--edit-item-id nil
+ "The id of the toot being edited.")
+
+(defvar-local mastodon-toot-previous-window-config nil
+ "A list of window configuration prior to composing a toot.
+Takes its form from `window-configuration-to-register'.")
+
+(defvar mastodon-toot--max-toot-chars nil
+ "The maximum allowed characters count for a single toot.")
+
+(defvar-local mastodon-toot-completions nil
+ "The data of completion candidates for the current completion at point.")
+
+(defvar mastodon-toot-current-toot-text nil
+ "The text of the toot being composed.")
+
+(defvar-local mastodon-toot-quote-policy nil
+ "The quote policy for the current toot.")
+
+(defvar-local mastodon-toot-quote-id nil)
+
+(persist-defvar mastodon-toot-draft-toots-list nil
+ "A list of toots that have been saved as drafts.
+For the moment we just put all composed toots in here, as we want
+to also capture toots that are \"sent\" but that don't successfully
+send.")
+
+\f
+;;; REGEXES
+
+(defvar mastodon-toot-handle-regex
+ (rx (group-n 2 ; include domain
+ (group-n 4 ; exclude domain
+ (| (any ?\( "\n" "\t" " ") bol) ; preceding things
+ ?@ ; first @
+ (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; username
+ (? ?@ (* (not (any "\n" "\t" " "))))) ; optional domain
+ (| "'" word-boundary))) ; boundary or possessive
+
+(defvar mastodon-toot-tag-regex
+ (rx (| (any ?\( "\n" "\t" " ") bol)
+ (group-n 2 ?# (+ (any "_" "A-Z" "a-z" "0-9")))
+ (| "'" word-boundary))) ; boundary or possessive
+
+(defvar mastodon-toot-emoji-regex
+ (rx (| (any ?\( "\n" "\t" " ") bol)
+ (group-n 2 ?: ; opening :
+ (+ (any "A-Z" "a-z" "0-9" "_"))
+ (? ?:)) ; closing :
+ word-boundary)) ; boundary
+
+(defvar mastodon-toot-url-regex
+ ;; adapted from ffap-url-regexp
+ (concat
+ "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix
+ "[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars
+ ;; "[ .,:;!?]\\b"))
+ ;; "/" ; poss an ending slash? incompat with boundary end:
+ "\\>")) ; boundary end
+
+\f
+;;; UTILS
+
+(defun mastodon-toot--base-toot-or-item-json ()
+ "Return the JSON data of either base-toot or item-json property.
+The former is for boost or favourite notifications, returning
+data about the item boosted or favourited."
+ (or (mastodon-tl--property 'base-toot :no-move) ; fave/boost notifs
+ (mastodon-tl--property 'item-json)))
+
+(defun mastodon-toot--inc-or-dec (count subtract)
+ "If SUBTRACT, decrement COUNT, else increment."
+ (if subtract
+ (1- count)
+ (1+ count)))
+
+\f
+;;; MACRO
+
+(defmacro mastodon-toot--with-toot-item (&rest body)
+ "Execute BODY if we have a toot object at point.
+Includes boosts, and notifications that display toots.
+This macro makes the local variable ID available."
+ (declare (debug t))
+ `(if (or (not (eq 'toot (mastodon-tl--property 'item-type :no-move)))
+ (member (mastodon-tl--property 'notification-type :no-move)
+ '("follow" "follow_request")))
+ (user-error "Looks like there's no toot at point?")
+ (mastodon-tl--with-toot-helper
+ (lambda (id)
+ ,@body))))
+
+(defun mastodon-tl--with-toot-helper (body-fun)
+ "Helper function for `mastodon-tl--with-toot-item'.
+Extract any common variables needed, such as base-item-id
+property, and call BODY-FUN on them."
+ (let ((id (mastodon-tl--property 'base-item-id)))
+ (funcall body-fun id)))
+
+\f
+;;; MODE MAP
+
+(defvar mastodon-toot-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-c") #'mastodon-toot-send)
+ (define-key map (kbd "C-c C-k") #'mastodon-toot-cancel)
+ (define-key map (kbd "C-c C-w") #'mastodon-toot-set-content-warning)
+ (define-key map (kbd "C-c C-n") #'mastodon-toot-toggle-nsfw)
+ (define-key map (kbd "C-c C-v") #'mastodon-toot-change-visibility)
+ (define-key map (kbd "C-c C-e") #'mastodon-toot-insert-emoji)
+ (define-key map (kbd "C-c C-a") #'mastodon-toot-attach-media)
+ (define-key map (kbd "C-c !") #'mastodon-toot-clear-all-attachments)
+ (define-key map (kbd "C-c C-p") #'mastodon-toot-create-poll)
+ (define-key map (kbd "C-c C-u") #'mastodon-toot-set-quote-policy)
+ (define-key map (kbd "C-c C-o") #'mastodon-toot-clear-poll)
+ (define-key map (kbd "C-c C-l") #'mastodon-toot-set-toot-language)
+ (define-key map (kbd "C-c C-s") #'mastodon-toot-schedule-toot)
+ map)
+ "Keymap for `mastodon-toot'.")
+
+(defun mastodon-toot-set-default-visibility ()
+ "Set the default visibility for toots on the server."
+ (interactive)
+ (let ((vis (completing-read "Set default visibility to:"
+ mastodon-toot-visibility-list
+ nil t)))
+ (mastodon-profile--update-preference "privacy" vis :source)))
+
+(defun mastodon-toot--get-max-toot-chars (&optional no-toot)
+ "Fetch max_toot_chars from `mastodon-instance-url' asynchronously.
+NO-TOOT means we are not calling from a toot buffer."
+ (mastodon-http--get-json-async
+ (mastodon-http--api "instance")
+ nil :silent
+ 'mastodon-toot--get-max-toot-chars-callback no-toot))
+
+(defun mastodon-toot--get-max-toot-chars-callback (json-response
+ &optional no-toot)
+ "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer.
+NO-TOOT means we are not calling from a toot buffer."
+ (let ((max-chars
+ (or (alist-get 'max_toot_chars json-response)
+ (alist-get 'max_characters ; some servers have this instead
+ (alist-get 'statuses
+ (alist-get 'configuration
+ json-response))))))
+ (setq mastodon-toot--max-toot-chars max-chars)
+ (unless no-toot
+ (with-current-buffer "*new toot*"
+ (mastodon-toot--update-status-fields)))))
+
+(defun mastodon-toot--action-success (marker byline-region remove &optional json)
+ "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.
+JSON is added to the string as its item-json."
+ (let ((inhibit-read-only t)
+ (bol (car byline-region))
+ (eol (cdr byline-region))
+ (at-byline-p (eq t (mastodon-tl--property 'byline :no-move))))
+ (save-excursion
+ (when remove
+ (goto-char bol)
+ (beginning-of-line) ;; The marker is not part of the byline
+ (if (search-forward (format "(%s) " marker) eol :no-error)
+ (replace-match "")
+ (user-error "Oops: could not find marker '(%s)'" marker)))
+ (unless remove
+ (goto-char bol)
+ (insert
+ (propertize
+ (format "(%s) "
+ (propertize marker
+ 'face 'success))
+ 'cursor-face 'mastodon-cursor-highlight-face
+ 'item-json json)))) ;; for (un)folding items
+ (when at-byline-p
+ ;; leave point after the marker:
+ (unless remove
+ ;; if point is inside the byline, back up first so
+ ;; we don't move to the following toot:
+ (beginning-of-line)
+ (forward-line -1)
+ (mastodon-tl-goto-next-item)))))
+
+(defun mastodon-toot--action (action callback)
+ "Take ACTION, a string, on toot at point, then execute CALLBACK.
+Makes a POST request to the server. Used for favouriting,
+boosting, or bookmarking toots."
+ (let* ((id (mastodon-tl--property 'base-item-id))
+ (url (mastodon-http--api
+ (concat "statuses/" (mastodon-tl--as-string id) "/" action)))
+ (response (mastodon-http--post url)))
+ (mastodon-http--triage response callback)))
+
+(defun mastodon-toot--toggle-boost-or-favourite (action)
+ "Toggle boost or favourite of toot at point.
+ACTION is a symbol, either `favourite' or `boost.'"
+ (mastodon-toot--with-toot-item
+ (let* ((n-type (mastodon-tl--property 'notification-type :no-move))
+ (byline-region (mastodon-tl--find-property-range 'byline (point)))
+ (boost-p (eq action 'boost))
+ (action-str (symbol-name action))
+ (item-json (mastodon-tl--property 'item-json))
+ (vis (mastodon-tl--field 'visibility item-json)))
+ (cond
+ ((not byline-region)
+ (user-error "Nothing to %s here?!?" action-str))
+ ;; there's nothing wrong with faving/boosting own toots
+ ;; & nothing wrong with faving/boosting own toots from notifs,
+ ;; it boosts/faves the base toot, not the notif status
+ ((or (string= n-type "follow")
+ (string= n-type "follow_request"))
+ (user-error "Can't %s %s notifications" action n-type))
+ ((and boost-p
+ (or (string= vis "direct")
+ (string= vis "private")))
+ (user-error "Can't boost posts with visibility: %s" vis))
+ (t
+ (let* ((boosted (when byline-region
+ (get-text-property (car byline-region) 'boosted-p)))
+ (faved (when byline-region
+ (get-text-property (car byline-region) 'favourited-p)))
+ (str-api (if boost-p "reblog" action-str))
+ (action-str-api (mastodon-toot--str-negify str-api faved boosted
+ action))
+ (action-pp (concat
+ (mastodon-toot--str-negify action-str faved boosted
+ action)
+ (if boost-p "ed" "d")))
+ (remove-p (if boost-p boosted faved)))
+ (mastodon-toot--action
+ action-str-api
+ (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 action remove-p)
+ (mastodon-toot--action-success (mastodon-tl--symbol action)
+ byline-region remove-p item-json))
+ (message "%s #%s" action-pp id)))))))))
+
+(defun mastodon-toot--str-negify (str faved boosted action)
+ "Add \"un\" to STR if item is already FAVED or BOOSTED.
+ACTION is the action currently being taken."
+ (if (eq action 'boost)
+ (if boosted (concat "un" str) str)
+ (if faved
+ (concat "un" str)
+ str)))
+
+(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."
+ (if (not (symbolp action))
+ (error "Invalid argument: symbolp %s" action)
+ (let* ((count-prop (if (eq action 'favourite)
+ 'favourites-count
+ 'boosts-count))
+ (count-range (mastodon-tl--find-property-range count-prop (point)))
+ (count (get-text-property (car count-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-range)
+ (cdr count-range)
+ (list 'display
+ (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'."
+ (interactive)
+ (mastodon-toot--toggle-boost-or-favourite 'boost))
+
+(defun mastodon-toot-toggle-favourite ()
+ "Favourite/unfavourite toot at `point'."
+ (interactive)
+ (mastodon-toot--toggle-boost-or-favourite 'favourite))
+
+;; TODO maybe refactor into boost/fave fun
+(defun mastodon-toot-toggle-bookmark ()
+ "Bookmark or unbookmark toot at point."
+ (interactive)
+ (mastodon-toot--with-toot-item
+ (let* ((n-type (mastodon-tl--property 'notification-type :no-move))
+ (byline-region (mastodon-tl--find-property-range 'byline (point)))
+ (bookmarked-p (when byline-region
+ (get-text-property (car byline-region) 'bookmarked-p)))
+ (action (if bookmarked-p "unbookmark" "bookmark")))
+ (cond ((or (string= n-type "follow")
+ (string= n-type "follow_request"))
+ (user-error "Can't bookmark %s notifications" n-type))
+ ((not byline-region)
+ (user-error "Nothing to %s here?!?" action))
+ (t
+ (let* ((bookmark-str (mastodon-tl--symbol 'bookmark))
+ (message (if bookmarked-p
+ "Bookmark removed!"
+ "Toot bookmarked!"))
+ (item-json (mastodon-tl--property 'item-json)))
+ (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 bookmarked-p item-json)
+ (message "%s #%s" message id))))))))))
+
+(defun mastodon-toot-list-boosters ()
+ "List the boosters of toot at point."
+ (interactive)
+ ;; use grouped notifs data if present:
+ ;; only send accounts as arg if type matches notif type we are acting
+ ;; on, to prevent showing accounts for a boost notif when asking for
+ ;; favers, and vice versa.
+ (let* ((type (mastodon-tl--property 'notification-type :no-move))
+ (accounts (when (string= type "reblog")
+ (mastodon-tl--property 'notification-accounts :no-move))))
+ (mastodon-toot--list-boosters-or-favers nil accounts)))
+
+(defun mastodon-toot-list-favouriters ()
+ "List the favouriters of toot at point."
+ (interactive)
+ (let* ((type (mastodon-tl--property 'notification-type :no-move))
+ (accounts (when (string= type "favourite")
+ (mastodon-tl--property 'notification-accounts :no-move))))
+ (mastodon-toot--list-boosters-or-favers :favourite accounts)))
+
+(defun mastodon-toot--list-boosters-or-favers (&optional favourite accounts)
+ "List the favouriters or boosters of toot at point.
+With FAVOURITE, list favouriters, else list boosters.
+ACCOUNTS is notfications accounts if any."
+ (mastodon-toot--with-toot-item
+ (let* ((endpoint (unless accounts
+ (if favourite "favourited_by" "reblogged_by")))
+ (url (unless accounts
+ (mastodon-http--api (format "statuses/%s/%s" id endpoint))))
+ (params (unless accounts '(("limit" . "80"))))
+ (json (or accounts (mastodon-http--get-json url params))))
+ (if (eq (caar json) 'error)
+ (user-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)
+ (user-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.
+If the toot is a fave/boost notification, copy the URL of the
+base toot."
+ (interactive)
+ (let* ((url (mastodon-toot--toot-url)))
+ (kill-new url)
+ (message "Toot URL copied to the clipboard.")))
+
+(defun mastodon-toot-browse-toot-url ()
+ "Browse URL of toot at point.
+Note that this loads the version of the toot on the remote server, not
+your own.
+Calls `browse-url'."
+ (interactive)
+ (browse-url
+ (mastodon-toot--toot-url)))
+
+(defun mastodon-toot--toot-url ()
+ "Return the URL of the base toot at point."
+ (let* ((toot (mastodon-toot--base-toot-or-item-json)))
+ (if (mastodon-tl--field 'reblog toot)
+ (alist-get 'url (alist-get 'reblog toot))
+ (alist-get 'url toot))))
+
+(defun mastodon-toot-copy-toot-text ()
+ "Copy text of toot at point.
+If the toot is a fave/boost notification, copy the text of the
+base toot."
+ (interactive)
+ (let* ((toot (mastodon-toot--base-toot-or-item-json)))
+ (kill-new (mastodon-tl--content toot))
+ (message "Toot content copied to the clipboard.")))
+
+(defun mastodon-toot-translate-toot-text ()
+ "Translate text of toot at point.
+Uses `lingva.el'."
+ (interactive)
+ (if mastodon-tl--buffer-spec
+ (if-let* ((toot (mastodon-tl--property 'item-json)))
+ (condition-case x
+ (lingva-translate nil
+ (mastodon-tl--content toot)
+ (when mastodon-tl--enable-proportional-fonts
+ t))
+ (void-function
+ (user-error "Looks like you need to install lingva.el. Error: %s"
+ (error-message-string x))))
+ (user-error "No toot to translate?"))
+ (user-error "No mastodon buffer?")))
+
+(defun mastodon-toot--own-toot-p (toot)
+ "Check if TOOT is user's own, for deleting, editing, or pinning it."
+ ;; this check needs to allow acting on own toots displayed as boosts, so we
+ ;; call `mastodon-tl--toot-or-base'.
+ (let ((json (mastodon-tl--toot-or-base toot)))
+ (string= (alist-get 'acct (alist-get 'account json))
+ (mastodon-auth--user-acct))))
+
+(defun mastodon-toot-pin-toot-toggle ()
+ "Pin or unpin user's toot at point."
+ (interactive)
+ (let* ((toot (mastodon-toot--base-toot-or-item-json))
+ (pinnable-p (mastodon-toot--own-toot-p toot))
+ (pinned-p (eq t (alist-get 'pinned toot)))
+ (action (if pinned-p "unpin" "pin"))
+ (msg (if pinned-p "unpinned" "pinned")))
+ (if (not pinnable-p)
+ (user-error "You can only pin your own toots")
+ (when (y-or-n-p (format "%s this toot? " (capitalize action)))
+ (mastodon-toot--action
+ action
+ (lambda (_)
+ ;; let's only reload when in own profile view:
+ (when (mastodon-tl--own-profile-buffer-p)
+ (mastodon-tl--reload-timeline-or-profile))
+ (message "Toot %s!" msg)))))))
+
+\f
+;;; DELETE, DRAFT, REDRAFT
+
+(defun mastodon-toot-delete-toot ()
+ "Delete user's toot at point synchronously."
+ (interactive)
+ (mastodon-toot-delete-and-redraft-toot t))
+
+;; TODO: handle media/poll for redrafting toots
+(defun mastodon-toot-delete-and-redraft-toot (&optional no-redraft)
+ "Delete and redraft user's toot at point synchronously.
+NO-REDRAFT means delete toot only."
+ (interactive)
+ (mastodon-toot--with-toot-item
+ (let* ((toot (mastodon-toot--base-toot-or-item-json))
+ (url (mastodon-http--api (format "statuses/%s" id)))
+ (attachmentsp (mastodon-tl--field 'media_attachments toot))
+ (pos (point)))
+ (let-alist toot
+ (if (not (mastodon-toot--own-toot-p toot))
+ (user-error "You can only delete (and redraft) your own toots")
+ (when (y-or-n-p (if no-redraft
+ "Delete this toot? "
+ "Delete and redraft this toot? "))
+ (let* ((params
+ (when (and attachmentsp
+ no-redraft
+ (y-or-n-p "Also delete toot's attachments?"))
+ `(("delete_media" . "true"))))
+ (response (mastodon-http--delete url params)))
+ (mastodon-http--triage
+ response
+ (lambda (_)
+ (if no-redraft
+ (progn
+ (when mastodon-tl--buffer-spec
+ (mastodon-tl--reload-timeline-or-profile pos))
+ (message "Toot deleted!"))
+ (mastodon-toot--redraft response
+ .in_reply_to_id
+ .visibility
+ .spoiler_text)))))))))))
+
+(defun mastodon-toot--set-cw (&optional cw)
+ "Set content warning to CW if it is non-nil."
+ (unless (or (null cw) ; cw is nil for `mastodon-tl-dm-user'
+ (string-empty-p cw))
+ (setq mastodon-toot--content-warning cw)))
+
+\f
+;;; REDRAFT
+
+(defun mastodon-toot--redraft (response &optional reply-id toot-visibility
+ toot-cw)
+ "Opens a new toot compose buffer using values from RESPONSE buffer.
+REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved."
+ (with-current-buffer response
+ (let* ((response (mastodon-http--process-json))
+ (content (alist-get 'text response)))
+ (mastodon-toot--compose-buffer)
+ (goto-char (point-max))
+ (insert content)
+ ;; adopt reply-to-id, visibility and CW from deleted toot:
+ (mastodon-toot--set-toot-properties
+ reply-id toot-visibility toot-cw
+ ;; TODO set new lang/scheduled props here
+ nil))))
+
+(defun mastodon-toot--set-toot-media-attachments (media)
+ "Set the media attachments variables.
+MEDIA is the media_attachments data for a status from the server."
+ (mapcar (lambda (x)
+ (cl-pushnew (alist-get 'id x)
+ mastodon-toot--media-attachment-ids)
+ (cl-pushnew `((:contents . ,(mastodon-http--read-file-as-string
+ (alist-get 'url x) :url))
+ (:description . ,(alist-get 'description x)))
+ mastodon-toot--media-attachments))
+ media))
+
+(defun mastodon-toot--set-toot-properties
+ (reply-id visibility cw lang
+ &optional scheduled scheduled-id media poll quote-id)
+ "Set the toot properties for the current redrafted or edited toot.
+REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set.
+MEDIA is the media_attachments data for a status from the server."
+ (with-current-buffer "*edit toot*"
+ (when reply-id
+ (setq mastodon-toot--reply-to-id reply-id))
+ (setq mastodon-toot--visibility visibility)
+ (setq mastodon-toot--scheduled-for scheduled)
+ (setq mastodon-toot--scheduled-id scheduled-id)
+ (when (not (string-empty-p lang))
+ (setq mastodon-toot--language lang))
+ (mastodon-toot--set-cw cw)
+ (when media
+ (mastodon-toot--set-toot-media-attachments media))
+ (when poll
+ (mastodon-toot--server-poll-to-local poll))
+ (setq mastodon-toot-quote-id quote-id)
+ (mastodon-toot--refresh-attachments-display)
+ (mastodon-toot--update-status-fields)))
+
+(defun mastodon-toot--kill (&optional cancel)
+ "Kill `mastodon-toot-mode' buffer and window.
+CANCEL means the toot was not sent, so we save the toot text as a draft."
+ (let ((prev-window-config mastodon-toot-previous-window-config))
+ (unless (eq mastodon-toot-current-toot-text nil)
+ (when cancel
+ (cl-pushnew mastodon-toot-current-toot-text
+ mastodon-toot-draft-toots-list :test #'string=)))
+ ;; prevent some weird bug when cancelling a non-empty toot:
+ (delete #'mastodon-toot--save-toot-text after-change-functions)
+ (quit-window 'kill)
+ (mastodon-toot--restore-previous-window-config prev-window-config)))
+
+(defun mastodon-toot-cancel ()
+ "Kill new-toot buffer/window. Does not POST content.
+If toot is not empty, prompt to save text as a draft."
+ (interactive)
+ (when (and (not (mastodon-toot--empty-p))
+ (y-or-n-p "Save draft toot?"))
+ (mastodon-toot-save-draft))
+ (mastodon-toot--kill))
+
+(defun mastodon-toot-save-draft ()
+ "Save the current compose toot text as a draft.
+Pushes `mastodon-toot-current-toot-text' to
+`mastodon-toot-draft-toots-list'."
+ (interactive)
+ (unless (string= mastodon-toot-current-toot-text nil)
+ (cl-pushnew mastodon-toot-current-toot-text
+ mastodon-toot-draft-toots-list :test 'string=)
+ (message "Draft saved!")))
+
+(defun mastodon-toot--empty-p (&optional text-only)
+ "Return t if toot has no text, attachments, or polls.
+TEXT-ONLY means don't check for attachments or polls."
+ (and (if text-only
+ t
+ (and (not mastodon-toot--media-attachments)
+ (not mastodon-toot-poll)))
+ (string-empty-p (mastodon-tl--clean-tabs-and-nl
+ (mastodon-toot--remove-docs)))))
+
+\f
+;;; EMOJIS
+
+(defun mastodon-toot-insert-emoji ()
+ "Prompt to insert an emoji."
+ (interactive)
+ (if mastodon-use-emojify
+ (emojify-insert-emoji)
+ (call-interactively #'emoji-search))) ;; 29.1
+
+(defun mastodon-toot--emoji-dir ()
+ "Return the file path for the mastodon custom emojis directory."
+ (concat (expand-file-name emojify-emojis-dir)
+ "/mastodon-custom-emojis/"))
+
+(defun mastodon-toot-download-custom-emoji ()
+ "Download `mastodon-instance-url's custom emoji.
+Emoji images are stored in a subdir of `emojify-emojis-dir'.
+To use the downloaded emoji, run `mastodon-toot-enable-custom-emoji'."
+ (interactive)
+ (let* ((url (mastodon-http--api "custom_emojis"))
+ (custom-emoji (mastodon-http--get-json url))
+ (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir)))
+ (if (not (file-directory-p emojify-emojis-dir))
+ (user-error "Looks like you need to set up emojify first")
+ (unless (file-directory-p mastodon-custom-emoji-dir)
+ (make-directory mastodon-custom-emoji-dir nil)) ; no add parent
+ (cl-loop for x in custom-emoji
+ do (let ((url (alist-get 'url x))
+ (shortcode (alist-get 'shortcode x)))
+ ;; skip anything that contains unexpected characters
+ (when (and url shortcode
+ (string-match-p "^[a-zA-Z0-9-_]+$" shortcode)
+ (string-match-p "^[a-zA-Z]+$" (file-name-extension url)))
+ (url-copy-file url
+ (concat mastodon-custom-emoji-dir
+ shortcode
+ "."
+ (file-name-extension url))
+ t))))
+ (message "Custom emoji for %s downloaded to %s"
+ mastodon-instance-url
+ mastodon-custom-emoji-dir))))
+
+(defun mastodon-toot--collect-custom-emoji ()
+ "Return a list of `mastodon-instance-url's custom emoji.
+The list is formatted for `emojify-user-emojis', which see."
+ (let* ((mastodon-custom-emojis-dir (mastodon-toot--emoji-dir))
+ (custom-emoji-files (directory-files mastodon-custom-emojis-dir
+ nil ; not full path
+ "^[^.]")) ; no dot files
+ mastodon-emojify-user-emojis)
+ (cl-loop for x in custom-emoji-files
+ do (push
+ `(,(concat ":"
+ (file-name-base x) ":")
+ . (("name" . ,(file-name-base x))
+ ("image" . ,(concat mastodon-custom-emojis-dir x))
+ ("style" . "github")))
+ mastodon-emojify-user-emojis))
+ (reverse mastodon-emojify-user-emojis)))
+
+(defun mastodon-toot-enable-custom-emoji ()
+ "Add `mastodon-instance-url's custom emoji to `emojify'.
+Custom emoji must first be downloaded with
+`mastodon-toot-download-custom-emoji'. Custom emoji are appended
+to `emojify-user-emojis', and the emoji data is updated."
+ (interactive)
+ (unless (file-exists-p (mastodon-toot--emoji-dir))
+ (when (y-or-n-p "Looks like you haven't downloaded your
+ instance's custom emoji yet. Download now? ")
+ (mastodon-toot-download-custom-emoji)))
+ (let ((masto-emojis (mastodon-toot--collect-custom-emoji)))
+ (unless (cl-find (car masto-emojis)
+ emojify-user-emojis
+ :test #'equal)
+ (setq emojify-user-emojis
+ (append masto-emojis
+ emojify-user-emojis))
+ ;; if already loaded, reload
+ (when (featurep 'emojify)
+ ;; we now only do this within the unless test above, as it is extremely
+ ;; slow and runs in `mastodon-mode-hook'.
+ (emojify-set-emoji-data)))))
+
+(defun mastodon-toot--remove-docs ()
+ "Get the body of a toot from the current compose buffer."
+ (let ((header-region (mastodon-tl--find-property-range 'toot-post-header
+ (point-min))))
+ (string-trim-left
+ (buffer-substring (cdr header-region) (point-max)))))
+
+(defun mastodon-toot--build-poll-params ()
+ "Return an alist of parameters for POSTing a poll status."
+ (if mastodon-toot-poll-use-transient
+ (let-alist mastodon-toot-poll
+ (append
+ (mastodon-http--build-array-params-alist
+ "poll[options][]"
+ (list .one .two .three .four))
+ (list (cons "poll[expires_in]" .expiry)
+ (cons "poll[multiple]" .multi)
+ (cons "poll[hide_totals]" .hide))))
+ (append
+ (mastodon-http--build-array-params-alist
+ "poll[options][]"
+ (plist-get mastodon-toot-poll :options))
+ `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry)))
+ `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi))))
+ `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide)))))))
+
+\f
+;;; SEND TOOT FUNCTION
+
+(defun mastodon-toot-send ()
+ "POST contents of new-toot buffer to fediverse instance and kill buffer.
+If media items have been attached and uploaded with
+`mastodon-toot-attach-media', they are attached to the toot.
+If `mastodon-toot--edit-item-id' is non-nil, PUT contents to
+instance to edit a toot."
+ (interactive)
+ (let* ((toot (mastodon-toot--remove-docs))
+ (scheduled mastodon-toot--scheduled-for)
+ (scheduled-id mastodon-toot--scheduled-id)
+ (edit-id mastodon-toot--edit-item-id)
+ (endpoint (mastodon-http--api (if edit-id ; we are sending an edit:
+ (format "statuses/%s" edit-id)
+ "statuses")))
+ (args-no-media
+ (append
+ `(("status" . ,toot)
+ ("in_reply_to_id" . ,mastodon-toot--reply-to-id)
+ ("visibility" . ,mastodon-toot--visibility)
+ ("sensitive" . ,(when mastodon-toot--content-nsfw
+ (symbol-name t)))
+ ("spoiler_text" . ,mastodon-toot--content-warning)
+ ("quote_approval_policy" . ,mastodon-toot-quote-policy)
+ ("language" . ,mastodon-toot--language)
+ ("quoted_status_id" . ,mastodon-toot-quote-id))
+ ;; Pleroma instances can't handle null-valued
+ ;; scheduled_at args, so only add if non-nil
+ (when scheduled `(("scheduled_at" . ,scheduled)))))
+ (args-media (when mastodon-toot--media-attachment-ids
+ (mastodon-http--build-array-params-alist
+ "media_ids[]"
+ mastodon-toot--media-attachment-ids)))
+ (args-poll (when mastodon-toot-poll
+ (mastodon-toot--build-poll-params)))
+ ;; media || polls:
+ (args (if mastodon-toot--media-attachment-ids
+ (append args-media args-no-media)
+ (if mastodon-toot-poll
+ (append args-no-media args-poll)
+ args-no-media)))
+ (prev-window-config mastodon-toot-previous-window-config))
+ (cond ((and mastodon-toot--media-attachment-ids
+ ;; make sure we have media args
+ ;; and the same num of ids as attachments
+ (or (not args-media)
+ (not (= (length mastodon-toot--media-attachments)
+ (length mastodon-toot--media-attachment-ids)))))
+ (user-error "Something is wrong with your uploads. Wait for them to complete or try again"))
+ ((and mastodon-toot--max-toot-chars
+ (> (mastodon-toot--count-toot-chars toot mastodon-toot--content-warning)
+ mastodon-toot--max-toot-chars))
+ (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length"))
+ ;; polls must have text, so we use poll as flag for text-only
+ ;; check here:
+ ((mastodon-toot--empty-p mastodon-toot-poll)
+ (user-error "Empty toot. Cowardly refusing to post this"))
+ (t
+ (let ((response (funcall (if edit-id ; we are sending an edit:
+ #'mastodon-http--put
+ #'mastodon-http--post)
+ endpoint args)))
+ (mastodon-http--triage
+ response
+ (lambda (_)
+ ;; kill buffer:
+ (mastodon-toot--kill)
+ ;; nil our poll var:
+ (setq mastodon-toot-poll nil)
+ (message "Toot %s!" (if scheduled "scheduled" "toot"))
+ ;; cancel scheduled toot if we were editing it:
+ (when scheduled-id
+ (mastodon-views-cancel-scheduled-toot
+ scheduled-id :no-confirm))
+ ;; window config:
+ (mastodon-toot--restore-previous-window-config prev-window-config)
+ ;; reload: - when we have been editing
+ ;; - when we are in thread view
+ ;; (we don't reload in every case as it can be slow and we
+ ;; may lose our place in a timeline.)
+ (let ((type (mastodon-tl--get-buffer-type)))
+ (when (or edit-id
+ (eq 'single-status type)
+ (eq 'thread type))
+ (let ((pos (marker-position (cadr prev-window-config))))
+ (mastodon-tl--reload-timeline-or-profile pos)))))))))))
+
+\f
+;;; EDITING TOOTS:
+
+(defun mastodon-toot-edit-toot-at-point ()
+ "Edit the user's toot at point."
+ (interactive)
+ (mastodon-toot--with-toot-item
+ (let ((toot (mastodon-toot--base-toot-or-item-json)))
+ (if (not (mastodon-toot--own-toot-p toot))
+ (user-error "You can only edit your own toots")
+ (let* ((source (mastodon-toot--get-toot-source id))
+ (content (alist-get 'text source))
+ (source-cw (alist-get 'spoiler_text source))
+ (quote (alist-get 'quote toot)))
+ (let-alist toot
+ (when (y-or-n-p "Edit this toot? ")
+ (mastodon-toot--compose-buffer nil .in_reply_to_id nil
+ content :edit)
+ (goto-char (point-max))
+ ;; adopt reply-to-id, visibility, CW, language, and media:
+ (mastodon-toot--set-toot-properties
+ .in_reply_to_id .visibility source-cw .language nil nil
+ ;; maintain media order:
+ (reverse .media_attachments) .poll
+ (map-nested-elt quote '(quoted_status id)))
+ (setq mastodon-toot--edit-item-id id))))))))
+
+(defun mastodon-toot--get-toot-source (id)
+ "Fetch the source JSON of toot with ID."
+ (let ((url (mastodon-http--api (format "/statuses/%s/source" id))))
+ (mastodon-http--get-json url nil :silent)))
+
+(defun mastodon-toot--get-toot-edits (id)
+ "Return the edit history of toot with ID."
+ (let* ((url (mastodon-http--api (format "statuses/%s/history" id))))
+ (mastodon-http--get-json url)))
+
+(defun mastodon-toot-view-toot-edits ()
+ "View editing history of the toot at point in a popup buffer."
+ (interactive)
+ (let ((id (mastodon-tl--property 'base-item-id))
+ (history (mastodon-tl--property 'edit-history)) ;; at byline
+ (buf "*mastodon-toot-edits*"))
+ (if (not history)
+ (user-error "No editing history for this toot")
+ (with-mastodon-buffer buf #'special-mode :other-window
+ (cl-loop for count from 1
+ for x in history
+ do (insert (propertize (if (= count 1)
+ (format "%s [original]:\n" count)
+ (format "%s:\n" count))
+ 'face 'mastodon-toot-docs-face)
+ (mastodon-toot--insert-toot-iter x)
+ "\n"))
+ (goto-char (point-min))
+ (setq-local header-line-format
+ (propertize
+ (format "Edits to toot by %s:"
+ (alist-get 'username
+ (alist-get 'account (car history))))
+ 'face 'mastodon-toot-docs-face))
+ (mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
+ (format "statuses/%s/history" id)
+ nil)))))
+
+(defun mastodon-toot--insert-toot-iter (it)
+ "Insert iteration IT of toot."
+ (let ((content (alist-get 'content it)))
+ ;; TODO: handle polls, media
+ (mastodon-tl--render-text content)))
+
+(defun mastodon-toot--restore-previous-window-config (config)
+ "Restore the window CONFIG after killing the toot compose buffer.
+Buffer-local variable `mastodon-toot-previous-window-config' holds the config."
+ (set-window-configuration (car config))
+ (goto-char (cadr config)))
+
+(defun mastodon-toot--mentions-to-string (mentions)
+ "Apply `mastodon-toot--process-local' function to each mention in MENTIONS.
+Remove empty string (self) from result and joins the sequence with whitespace."
+ (let ((mentions (remove ""
+ (mapcar #'mastodon-toot--process-local mentions))))
+ (mapconcat #'identity mentions " ")))
+
+(defun mastodon-toot--process-local (acct)
+ "Add domain to local ACCT and replace the curent user name with \"\".
+Mastodon requires the full @user@domain, even in the case of local accts.
+eg. \"user\" -> \"@userNOSPAMlocal.social\" (when local.social is the domain of the
+`mastodon-instance-url').
+eg. \"yourusername\" -> \"\"
+eg. \"feduserNOSPAMfed.social\" -> \"@feduserNOSPAMfed.social\"."
+ (cond ((string-match-p "@" acct) (concat "@" acct)) ; federated acct
+ ((string= (mastodon-auth--user-acct) acct) "") ; your acct
+ (t
+ (concat "@" acct "@" ; local acct
+ (cadr
+ (split-string mastodon-instance-url "/" :omit-nulls))))))
+
+\f
+;;; COMPLETION (TAGS, MENTIONS)
+
+(defun mastodon-toot--mentions (status)
+ "Extract mentions (not the reply-to author or booster) from STATUS.
+The mentioned users look like this:
+Local user (including the logged in): `username`.
+Federated user: `usernameNOSPAMhost.co`."
+ (let* ((mentions (mastodon-tl--field 'mentions status)))
+ ;; reverse does not work on vectors in 24.5
+ (mastodon-tl--map-alist 'acct (reverse mentions))))
+
+(defun mastodon-toot--get-bounds (regex)
+ "Get bounds of tag or handle before point using REGEX."
+ ;; # and @ are not part of any existing thing at point
+ (save-match-data
+ (save-excursion
+ ;; match full handle inc. domain, or tag including #
+ ;; (see the regexes for subexp 2)
+ (when (re-search-backward regex
+ (save-excursion (forward-whitespace -1)
+ (point))
+ :no-error)
+ (cons (match-beginning 2)
+ (match-end 2))))))
+
+(defun mastodon-toot--fetch-emojify-candidates ()
+ "Get the candidates to be used for emojis completion.
+The candidates are calculated according to currently active
+`emojify-emoji-styles'. Hacked off
+`emojify--get-completing-read-candidates'."
+ (let ((styles (mapcar #'symbol-name emojify-emoji-styles)))
+ (let ((emojis '()))
+ (emojify-emojis-each
+ (lambda (key value)
+ (when (seq-position styles (ht-get value "style"))
+ (push (cons key
+ (format "%s (%s)"
+ (ht-get value "name")
+ (ht-get value "style")))
+ emojis))))
+ emojis)))
+
+(defun mastodon-toot--fetch-candidates (start end &optional type)
+ "Search for a completion prefix from buffer positions START to END.
+Return a list of candidates.
+TYPE is the candidate type, it may be :tags, :handles, or :emoji."
+ ;; we can't save the first two-letter search then only filter the
+ ;; resulting list, as max results returned is 40.
+ (setq mastodon-toot-completions
+ (cond ((eq type :tags)
+ (let ((tags-list (mastodon-search--search-tags-query
+ (buffer-substring-no-properties start end))))
+ (cl-loop for tag in tags-list
+ collect (cons (concat "#" (car tag))
+ (cdr tag)))))
+ ((eq type :emoji)
+ (when (bound-and-true-p emojify-mode)
+ (mastodon-toot--fetch-emojify-candidates)))
+ (t
+ (mastodon-search--search-accounts-query
+ (buffer-substring-no-properties start end))))))
+
+(defun mastodon-toot--make-capf (regex annot-fun type)
+ "Build a completion backend for `completion-at-point-functions'.
+REGEX is the regex to match preceding text.
+TYPE is a keyword symbol for `mastodon-toot--fetch-candidates'.
+ANNOT-FUN is a function returning an annotatation from a single
+arg, a candidate."
+ (let* ((bounds (mastodon-toot--get-bounds regex))
+ (start (car bounds))
+ (end (cdr bounds)))
+ (when bounds
+ (list start
+ end
+ (completion-table-dynamic ; only search when necessary
+ (lambda (_)
+ ;; Interruptible candidate computation, from minad/d mendler, thanks!
+ (let ((result
+ (while-no-input
+ (mastodon-toot--fetch-candidates
+ start end type))))
+ (and (consp result) result))))
+ :exclusive 'no
+ :annotation-function
+ (lambda (cand)
+ (concat " " (funcall annot-fun cand)))))))
+
+(defun mastodon-toot--mentions-capf ()
+ "Build a mentions completion backend for `completion-at-point-functions'."
+ (mastodon-toot--make-capf mastodon-toot-handle-regex
+ #'mastodon-toot--mentions-annotation-fun
+ :handles))
+
+(defun mastodon-toot--tags-capf ()
+ "Build a tags completion backend for `completion-at-point-functions'."
+ (mastodon-toot--make-capf mastodon-toot-tag-regex
+ #'mastodon-toot--tags-annotation-fun
+ :tags))
+
+(defun mastodon-toot--emoji-capf ()
+ "Build an emoji completion backend for `completion-at-point-functions'."
+ (mastodon-toot--make-capf mastodon-toot-emoji-regex
+ #'mastodon-toot--emoji-annotation-fun
+ :emoji))
+
+(defun mastodon-toot--mentions-annotation-fun (candidate)
+ "Given a handle completion CANDIDATE, return its annotation string, a username."
+ (caddr (assoc candidate mastodon-toot-completions)))
+
+(defun mastodon-toot--tags-annotation-fun (candidate)
+ "Given a tag string CANDIDATE, return an annotation, the tag's URL."
+ ;; TODO: check the list returned here? should be cadr
+ ;; or make it an alist and use cdr
+ (cadr (assoc candidate mastodon-toot-completions)))
+
+(defun mastodon-toot--emoji-annotation-fun (candidate)
+ "CANDIDATE."
+ ;; TODO: emoji image as annot
+ (cdr (assoc candidate mastodon-toot-completions)))
+
+\f
+;;; REPLY
+
+(defun mastodon-toot-reply ()
+ "Reply to toot at `point'.
+Customize `mastodon-toot-display-orig-in-reply-buffer' to display
+text of the toot being replied to in the compose buffer.
+If the region is active, inject it into the reply buffer,
+prefixed by >."
+ (interactive)
+ (mastodon-toot--with-toot-item
+ (let* ((quote (when (region-active-p)
+ (buffer-substring (region-beginning)
+ (region-end))))
+ (toot (mastodon-toot--base-toot-or-item-json))
+ (account (mastodon-tl--field 'account toot))
+ (user (alist-get 'acct account))
+ (mentions (mastodon-toot--mentions toot))
+ (boosted (mastodon-tl--field 'reblog toot))
+ (booster (when boosted
+ (alist-get 'acct
+ (alist-get 'account toot))))
+ (mentions
+ (cond ((and booster ;; different booster, user and mentions:
+ (and (not (string= user booster))
+ (not (member booster mentions))))
+ (mastodon-toot--mentions-to-string
+ (append (list user booster) mentions nil)))
+ ((not (member user mentions)) ;; user not in mentions:
+ (mastodon-toot--mentions-to-string
+ (append (list user) mentions nil)))
+ (t ;; user already in mentions:
+ (mastodon-toot--mentions-to-string
+ (copy-sequence mentions))))))
+ (mastodon-toot--compose-buffer mentions id toot quote))))
+
+\f
+;;; COMPOSE TOOT SETTINGS
+
+(defun mastodon-toot-set-content-warning ()
+ "Set a content warning for the current toot."
+ (interactive)
+ (setq mastodon-toot--content-warning
+ (read-string "Warning: " mastodon-toot--content-warning))
+ (mastodon-toot--update-status-fields))
+
+(defun mastodon-toot-toggle-nsfw ()
+ "Toggle `mastodon-toot--content-nsfw'."
+ (interactive)
+ (setq mastodon-toot--content-nsfw
+ (not mastodon-toot--content-nsfw))
+ (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off"))
+ (mastodon-toot--update-status-fields))
+
+(defun mastodon-toot-change-visibility (&optional arg)
+ "Change the current visibility to the next valid value.
+With prefix ARG, read a visibility type in the minibuffer."
+ (interactive "P")
+ (if (mastodon-tl--buffer-type-eq 'edit-toot)
+ (user-error "You can't change visibility when editing toots")
+ (setq mastodon-toot--visibility
+ (if arg
+ (completing-read "Visibility: "
+ mastodon-toot-visibility-list)
+ (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-set-toot-language ()
+ "Prompt for a language and set `mastodon-toot--language'.
+Return its two letter ISO 639 1 code."
+ (interactive)
+ (let* ((choice (completing-read "Language for this toot: "
+ mastodon-iso-639-1)))
+ (setq mastodon-toot--language
+ (alist-get choice mastodon-iso-639-1 nil nil #'string=))
+ (message "Language set to %s" choice)
+ (mastodon-toot--update-status-fields)))
+
+(defun mastodon-toot-set-quote-policy ()
+ "Set quote policy for the current toot."
+ (interactive)
+ (let* ((default (alist-get 'posting:default:quote_policy
+ (mastodon-http--get-json
+ (mastodon-http--api "preferences"))))
+ (choice (completing-read
+ (format "Quote policy for this toot [default: %s]"
+ default)
+ mastodon-profiles-quote-policy-types)))
+ (setq mastodon-toot-quote-policy choice)
+ (message (concat "Quote policy for this toot: " choice))
+ (mastodon-toot--update-status-fields)))
+
+\f
+;;; ATTACHMENTS
+
+(defun mastodon-toot--delete-attachments ()
+ "Delete each attachment on the server.
+Makes a DELETE request for each item in
+`mastodon-toot--media-attachment-ids'."
+ (while mastodon-toot--media-attachment-ids
+ (let* ((id (pop mastodon-toot--media-attachment-ids))
+ (url (mastodon-http--api
+ (format "media/%s"
+ id)))
+ (resp (mastodon-http--delete url)))
+ (mastodon-http--triage resp
+ (lambda (_resp)
+ (message "File %s deleted!" id))))))
+
+(defun mastodon-toot-clear-all-attachments ()
+ "Remove all attachments from a toot draft.
+If user so chooses, also delete the files on the server."
+ (interactive)
+ (setq mastodon-toot--media-attachments nil)
+ (if (not (y-or-n-p "Also delete attachments on the server?"))
+ (setq mastodon-toot--media-attachment-ids nil)
+ (mastodon-toot--delete-attachments))
+ (mastodon-toot--refresh-attachments-display)
+ (mastodon-toot--update-status-fields))
+
+(defun mastodon-toot--get-instance-max-attachments ()
+ "Return the maximum attachments from `mastodon-active-user's instance.
+If that fails, return 4 as a fallback"
+ ;; FIXME: this likely various for other server types:
+ ;; pleroma doesn't advertise this on "api/v1/instance" (checked
+ ;; fe.disroot.org)
+ (or
+ (let ((config (alist-get 'statuses
+ (alist-get 'configuration
+ (mastodon-views--get-own-instance)))))
+ (alist-get 'max_media_attachments config))
+ 4)) ; mastodon default as fallback
+
+(defun mastodon-toot-attach-media ()
+ "Prompt for an attachment file.
+A preview is displayed in the new toot buffer, and the file
+is uploaded asynchronously using `mastodon-toot--upload-attached-media'.
+File is actually attached to the toot upon posting."
+ (interactive)
+ (if mastodon-toot-quote-id
+ (user-error "You can't add attachments to quote toots")
+ (let ((file (read-file-name "Filename: "))
+ (description (read-string "Description: "))
+ (max-attachments (mastodon-toot--get-instance-max-attachments)))
+ (when (>= (length mastodon-toot--media-attachments)
+ max-attachments)
+ ;; warn + pop the oldest one:
+ (when (y-or-n-p
+ (format "Maximum attachments (%s) reached: remove first one?"
+ max-attachments))
+ (pop mastodon-toot--media-attachments)))
+ (if (file-directory-p file)
+ (user-error "Looks like you chose a directory not a file")
+ (setq mastodon-toot--media-attachments
+ (nconc mastodon-toot--media-attachments
+ `(((:contents . ,(mastodon-http--read-file-as-string file))
+ (:description . ,description)
+ (:filename . ,file)))))
+ (mastodon-toot--refresh-attachments-display)
+ ;; upload only most recent attachment:
+ (mastodon-toot--upload-attached-media
+ (car (last mastodon-toot--media-attachments)))))))
+
+(defun mastodon-toot--attachment-descriptions ()
+ "Return a list of image descriptions for current attachments."
+ (mastodon-tl--map-alist :description mastodon-toot--media-attachments))
+
+(defun mastodon-toot--attachment-from-desc (desc)
+ "Return an attachment based on its description DESC."
+ (car
+ (cl-member-if (lambda (x)
+ (rassoc desc x))
+ mastodon-toot--media-attachments)))
+
+(defun mastodon-toot-edit-media-description ()
+ "Prompt for an attachment, and update its description."
+ (interactive)
+ (let* ((descs (mastodon-toot--attachment-descriptions))
+ (choice (completing-read "Attachment: " descs nil :match))
+ (attachment (mastodon-toot--attachment-from-desc choice))
+ (desc-new (read-string "Description: " choice)))
+ (setf (alist-get :description attachment)
+ desc-new)
+ (mastodon-toot--refresh-attachments-display)))
+
+(defun mastodon-toot--upload-attached-media (attachment)
+ "Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'.
+The item's id is added to `mastodon-toot--media-attachment-ids',
+which is used to attach it to a toot when posting."
+ (let* ((filename (expand-file-name (alist-get :filename attachment)))
+ (caption (alist-get :description attachment))
+ (url (concat mastodon-instance-url "/api/v2/media")))
+ (message "Uploading %s... (please wait before starting further uploads)"
+ (file-name-nondirectory filename))
+ (mastodon-http--post-media-attachment url filename caption)))
+
+(defun mastodon-toot--refresh-attachments-display ()
+ "Update the display attachment previews in toot draft buffer."
+ (let ((inhibit-read-only t)
+ (attachments-region (mastodon-tl--find-property-range
+ 'toot-attachments (point-min)))
+ (display-specs (mastodon-toot--format-attachments)))
+ (dotimes (i (- (cdr attachments-region) (car attachments-region)))
+ (add-text-properties (+ i (car attachments-region))
+ (+ i 1 (car attachments-region))
+ (list 'display (or (nth i display-specs) ""))))))
+
+(defun mastodon-toot--format-attachments ()
+ "Format the attachment previews for display in toot draft buffer."
+ (or
+ (let ((image-options (when (mastodon-tl--image-trans-check)
+ `(:height ,mastodon-toot--attachment-height))))
+ (cl-loop for count from 1
+ for att in mastodon-toot--media-attachments
+ nconc
+ (let* ((data (alist-get :contents att))
+ (image (apply #'create-image data
+ (if (version< emacs-version "27.1")
+ (when image-options 'imagemagick)
+ nil) ; inbuilt scaling in 27.1
+ t image-options))
+ (desc (alist-get :description att)))
+ (list (format "\n %d: " count)
+ image
+ (format " \"%s\"" desc)))))
+ (list "None")))
+
+\f
+;;; POLL
+
+(defun mastodon-toot--fetch-max-poll-options (instance)
+ "Return the maximum number of poll options from JSON data INSTANCE."
+ (mastodon-toot--fetch-poll-field 'max_options instance))
+
+(defun mastodon-toot--fetch-max-poll-option-chars (instance)
+ "Return the maximum number of characters a poll option may have.
+INSTANCE is JSON."
+ (if (alist-get 'pleroma instance)
+ (mastodon-toot--fetch-poll-field 'max_option_chars instance)
+ (or (mastodon-toot--fetch-poll-field 'max_characters_per_option instance)
+ 50))) ; masto default
+
+(defun mastodon-toot--fetch-poll-field (field instance)
+ "Return FIELD from the poll settings from JSON data INSTANCE."
+ (let* ((polls (if (alist-get 'pleroma instance)
+ (alist-get 'poll_limits instance)
+ (alist-get 'polls
+ (alist-get 'configuration instance)))))
+ (alist-get field polls)))
+
+(defun mastodon-toot--read-poll-options-count (max)
+ "Read the user's choice of the number of options the poll should have.
+MAX is the maximum number set by their instance."
+ (let ((number (read-number (format "Number of options [2-%s]: " max) 2)))
+ (if (> number max)
+ (user-error "You need to choose a number between 2 and %s" max)
+ number)))
+
+(defun mastodon-toot-create-poll ()
+ "Prompt for new poll options and return as a list."
+ (interactive)
+ (cond (mastodon-toot-quote-id
+ (user-error "You can't add a poll to a quote toot"))
+ (mastodon-toot-poll-use-transient
+ (call-interactively #'mastodon-create-poll))
+ (t (mastodon-toot--read-poll))))
+
+(defun mastodon-toot--read-poll ()
+ "Read poll options."
+ (let* ((instance (mastodon-instance-data))
+ (max-options (mastodon-toot--fetch-max-poll-options instance))
+ (count (mastodon-toot--read-poll-options-count max-options))
+ (length (mastodon-toot--fetch-max-poll-option-chars instance))
+ (multiple-p (y-or-n-p "Multiple choice? "))
+ (options (mastodon-toot--read-poll-options count length))
+ (hide-totals (y-or-n-p "Hide votes until poll ends? "))
+ (expiry (mastodon-toot--read-poll-expiry))
+ (expiry-str (cdr expiry))
+ (expiry-human (car expiry)))
+ (setq mastodon-toot-poll
+ `( :options ,options :length ,length :expiry-readable ,expiry-human
+ :expiry ,expiry-str :multi ,multiple-p :hide ,hide-totals))
+ (message "poll created!")
+ (mastodon-toot--update-status-fields)))
+
+(defun mastodon-toot--read-poll-options (count length)
+ "Read a list of options for poll with COUNT options.
+LENGTH is the maximum character length allowed for a poll option."
+ (let* ((choices
+ (cl-loop for x from 1 to count
+ collect (read-string
+ (format "Poll option [%s/%s] [max %s chars]: "
+ x count length))))
+ (longest (apply #'max (mapcar #'length choices))))
+ (if (not (> longest length))
+ choices
+ (user-error "Looks like you went over the max length. Try again")
+ (sleep-for 2)
+ (mastodon-toot--read-poll-options count length))))
+
+(defun mastodon-toot--read-poll-expiry ()
+ "Prompt for a poll expiry time.
+Return a cons of a human readable string, and a seconds-from-now string."
+ ;; API requires this in seconds
+ (let* ((options (mastodon-toot--poll-expiry-options-alist))
+ (response (completing-read "poll ends in [or enter seconds]: "
+ options nil 'confirm)))
+ (or (assoc response options #'string=)
+ (if (< (string-to-number response) 300)
+ (cons "5 minutes" (number-to-string (* 60 5))) ;; min 5 mins
+ (cons (format "%s seconds" response) response)))))
+
+(defun mastodon-toot--poll-expiry-options-alist ()
+ "Return an alist of expiry options options in seconds."
+ `(("5 minutes" . ,(number-to-string (* 60 5)))
+ ("30 minutes" . ,(number-to-string (* 60 30)))
+ ("1 hour" . ,(number-to-string (* 60 60)))
+ ("6 hours" . ,(number-to-string (* 60 60 6)))
+ ("1 day" . ,(number-to-string (* 60 60 24)))
+ ("3 days" . ,(number-to-string (* 60 60 24 3)))
+ ("7 days" . ,(number-to-string (* 60 60 24 7)))
+ ("14 days" . ,(number-to-string (* 60 60 24 14)))
+ ("30 days" . ,(number-to-string (* 60 60 24 30)))))
+
+(defun mastodon-toot-clear-poll (&optional transient)
+ "Remove poll from toot compose buffer.
+Sets `mastodon-toot-poll' to nil.
+If TRANSIENT, we are called from a transient, so nil
+`tp-transient-settings' too."
+ (interactive)
+ (let ((var (if transient
+ 'tp-transient-settings
+ 'mastodon-toot-poll)))
+ (if (not (symbol-value var))
+ (user-error "No poll?")
+ (set var nil)
+ (when transient
+ (setq mastodon-toot-poll nil))
+ (mastodon-toot--update-status-fields))))
+
+(defun mastodon-toot--server-poll-to-local (json)
+ "Convert server poll data JSON to a `mastodon-toot-poll' plist."
+ (let-alist json
+ (let* ((expiry-seconds-rel
+ (time-to-seconds
+ (time-subtract
+ (encode-time
+ (parse-time-string .expires_at))
+ (current-time))))
+ (expiry-str (format-time-string "%s" expiry-seconds-rel))
+ (expiry-human (car
+ (mastodon-tl--human-duration expiry-seconds-rel)))
+ (options (mastodon-tl--map-alist 'title .options))
+ (multiple (if (eq :json-false .multiple) nil t)))
+ (if mastodon-toot-poll-use-transient
+ (setq mastodon-toot-poll
+ `((multi . ,multiple)
+ (expiry . ,expiry-str)
+ ;; (hide . ,hide)
+ (one . ,(nth 0 options))
+ (two . ,(nth 1 options))
+ (three . ,(nth 2 options))
+ (four . ,(nth 3 options))))
+ (setq mastodon-toot-poll
+ `( :options ,options :expiry-readable ,expiry-human
+ :expiry ,expiry-str :multi ,multiple))))))
+
+;;; QUOTE
+
+(defvar mastodon-toot-quote-approval-user
+ '("automatic" "manual" "denied" "unknown"))
+
+(defvar mastodon-toot-quote-approval-auto-or-manual
+ '("public" "followers" "following" "unsupported_policy"))
+
+(defun mastodon-toot-quote ()
+ "Compose a toot quoting the toot at point."
+ (interactive)
+ ;; boosted toot or toot:
+ (let* ((quote-id (mastodon-tl--property 'base-item-id))
+ (json (mastodon-tl--property 'item-json))
+ (policy (alist-get 'quote_approval json))
+ (user-policy (alist-get 'current_user policy))
+ ;; Respect visibility when quoting a toot:
+ ;; According to web UI settings (preferences/posting defaults):
+
+ ;; - quoting an unlisted ("quiet public") post, means quoting post also unlisted
+ ;; "When people quote you, their post will also be hidden from trending timelines."
+
+ ;; - private ("followers only") means no quoting allowed
+ ;; "Followers-only posts authored on Mastodon can't be quoted by others."
+ ;; BUT: we don't need to enforce this, as user-policy will be "denied"
+ ;; if toot is "private"
+
+ ;; "Quoting a private post will restrict the quoting post’s
+ ;; visibility to private or direct (if the given visibility is
+ ;; public or unlisted, private will be used instead)."
+
+ ;; <https://docs.joinmastodon.org/methods/statuses/#form-data-parameters>
+
+ ;; for now all we do is hand on quoted toot's visibility:
+ (visibility (mastodon-tl--field 'visibility json)))
+ (if (string= user-policy "denied")
+ (user-error "You don't have permission to quote this toot")
+ (when (or (not (string= user-policy "unknown"))
+ (y-or-n-p "Quote permission unknown. Proceed?"))
+ (mastodon-toot--compose-buffer nil nil nil nil nil
+ quote-id json visibility)))))
+
+(defun mastodon-toot-jump-to-quoting ()
+ "Prompt for a toot quoting the toot at point and load it."
+ (interactive)
+ (mastodon-toot--with-toot-item
+ (let* ((json (mastodon-tl--toot-or-base
+ (mastodon-tl--property 'item-json)))
+ (quotes (alist-get 'quotes_count json)))
+ (if (= 0 quotes)
+ (user-error "Item has no quotes?")
+ ;; with-toot-item fetches base id:
+ (let* ((data (mastodon-toot--get-quoting id))
+ (users (cl-loop for x in data
+ collect (map-nested-elt x '(account acct))))
+ (completion-extra-properties
+ `(:annotation-function
+ ,(lambda (cand)
+ (let ((user (cl-find-if
+ (lambda (entry)
+ (string= cand
+ (map-nested-elt entry '(account acct))))
+ data)))
+ (concat " "
+ (map-nested-elt user '(account username)))))))
+ (choice (completing-read "Load quoting toot by:" users))
+ (choice-item (cl-find-if
+ (lambda (x)
+ (string= choice
+ (map-nested-elt x '(account acct))))
+ data)))
+ (mastodon-tl--thread-do (alist-get 'id choice-item)))))))
+
+(defun mastodon-toot--get-quoting (id)
+ "Get statuses that quote item with ID."
+ ;; link header for paginating
+ ;; limit param default 20 max 40
+ (let ((endpoint (mastodon-http--api
+ (format "statuses/%s/quotes" id))))
+ (mastodon-http--get-json endpoint)))
+
+\f
+;;; SCHEDULE
+
+(defun mastodon-toot-schedule-toot (&optional reschedule)
+ "Read a date (+ time) in the minibuffer and schedule the current toot.
+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)
+ (cond ((mastodon-tl--buffer-type-eq 'edit-toot)
+ (user-error "You can't schedule toots you're editing"))
+ ((not (or (mastodon-tl--buffer-type-eq 'new-toot)
+ (mastodon-tl--buffer-type-eq 'scheduled-statuses)))
+ (user-error "You can only schedule toots from the compose buffer or 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 "Toot scheduled for %s." msg-str))
+ (let* ((args `(("scheduled_at" . ,iso8601-str)))
+ (url (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 "Toot rescheduled for %s." msg-str)))))))))
+
+(defun mastodon-toot--iso-to-human (ts)
+ "Format an ISO8601 timestamp TS to be more human-readable."
+ (let* ((decoded (iso8601-parse ts))
+ (encoded (encode-time decoded)))
+ (format-time-string "%d-%m-%y, %H:%M[%z]" encoded)))
+
+(defun mastodon-toot--iso-to-org (ts)
+ "Convert ISO8601 timestamp TS to something `org-read-date' can handle."
+ (when ts
+ (let* ((decoded (iso8601-parse ts)))
+ (encode-time decoded))))
+
+\f
+;;; DISPLAY KEYBINDINGS
+
+(defun mastodon-toot--get-kbinds ()
+ "Get a list of the keybindings in the `mastodon-toot-mode'."
+ (let* ((binds (copy-tree mastodon-toot-mode-map))
+ (prefix (car (cadr binds)))
+ (bindings (remove nil
+ (mapcar (lambda (i)
+ (when (listp i) i))
+ (cadr binds)))))
+ (mapcar (lambda (b)
+ (setf (car b) (vector prefix (car b)))
+ b)
+ bindings)))
+
+(defun mastodon-toot--format-kbind-command (cmd)
+ "Format CMD to be more readable.
+e.g. `mastodon-toot-send' -> Send."
+ (let* ((str (symbol-name cmd))
+ (re "mastodon-toot-\\(.*\\)$")
+ (str2 (save-match-data
+ (string-match re str)
+ (match-string 1 str))))
+ (capitalize (replace-regexp-in-string "-" " " str2))))
+
+(defun mastodon-toot--format-kbind (kbind)
+ "Format a single keybinding, KBIND, for display in documentation."
+ (let ((key (concat "\\`"
+ (help-key-description (car kbind) nil)
+ "'"))
+ (command (mastodon-toot--format-kbind-command (cdr kbind))))
+ (substitute-command-keys
+ (format
+ (concat (mastodon-toot--comment " ")
+ "%-10s"
+ (mastodon-toot--comment " - %s"))
+ key command))))
+
+(defun mastodon-toot--comment (str)
+ "Propertize STR with `mastodon-toot-docs-face'."
+ (propertize str
+ 'face 'mastodon-toot-docs-face))
+
+(defun mastodon-toot--format-kbinds (kbinds)
+ "Format a list of keybindings, KBINDS, for display in documentation."
+ (mapcar #'mastodon-toot--format-kbind kbinds))
+
+(defvar-local mastodon-toot--kbinds-pairs nil
+ "Contains a list of paired toot compose buffer keybindings for inserting.")
+
+(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest)
+ "Return a list of strings each containing two formatted kbinds.
+KBINDS-LIST is the list of formatted bindings to pair.
+LONGEST is the length of the longest binding."
+ (when kbinds-list
+ (push (concat "\n"
+ (car kbinds-list)
+ (make-string (- (1+ longest) (length (car kbinds-list)))
+ ?\ )
+ (cadr kbinds-list))
+ mastodon-toot--kbinds-pairs)
+ (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest))
+ (reverse mastodon-toot--kbinds-pairs))
+
+(defun mastodon-toot--kbinds-longest (kbinds-list)
+ "Return the length of the longest item in KBINDS-LIST."
+ (let ((lengths (mapcar #'length kbinds-list)))
+ (car (sort lengths #'>))))
+
+\f
+;;; DISPLAY DOCS
+
+(defun mastodon-toot--make-mode-docs ()
+ "Create formatted documentation text for `mastodon-toot-mode'."
+ (let* ((kbinds (mastodon-toot--get-kbinds))
+ (formatted (mastodon-toot--format-kbinds kbinds))
+ (longest-kbind (mastodon-toot--kbinds-longest
+ formatted)))
+ (concat
+ (mastodon-toot--comment
+ " Compose a new toot here. The following keybindings are available:")
+ (mapconcat
+ #'identity
+ (mastodon-toot--formatted-kbinds-pairs formatted longest-kbind)
+ nil))))
+
+(defun mastodon-toot--format-reply-in-compose (reply-text &optional quote-text)
+ "Format a REPLY-TEXT for display in compose buffer docs.
+Optionally format QUOTE-TEXT."
+ (let* ((rendered (mastodon-tl--render-text (or quote-text reply-text)))
+ (no-props (substring-no-properties rendered))
+ ;; FIXME: this replaces \n at end of every post, so we have to trim:
+ (no-newlines (string-trim
+ (replace-regexp-in-string "[\n]+" " " no-props)))
+ (prompt (concat (if quote-text " Quoting: \"" " Reply to: \"")
+ no-newlines "\""))
+ (crop (truncate-string-to-width
+ prompt mastodon-toot-orig-in-reply-length)))
+ (if (> (length no-newlines)
+ (length crop)) ; we cropped:
+ (concat crop "\n")
+ (concat prompt "\n"))))
+
+(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text quote-text)
+ "Insert propertized text with documentation about `mastodon-toot-mode'.
+Also includes and the status fields which will get updated based
+on the status of NSFW, content warning flags, media attachments, etc.
+REPLY-TEXT is the text of the toot being replied to.
+QUOTE-TEXT is that of the toot being quoted if so."
+ (let ((divider
+ "|=================================================================|"))
+ (insert
+ (concat
+ (mastodon-toot--make-mode-docs) "\n"
+ (mastodon-toot--comment divider) "\n"
+ (propertize
+ (concat
+ " "
+ (propertize "Count"
+ 'toot-post-counter t)
+ " ⋅ "
+ (propertize "Visibility"
+ 'toot-post-visibility t)
+ " ⋅ "
+ (propertize "Language"
+ 'toot-post-language t)
+ " "
+ (propertize "Scheduled"
+ 'toot-post-scheduled t)
+ " "
+ (propertize "CW"
+ 'toot-post-cw-flag t)
+ " "
+ (propertize "POLL"
+ 'toot-post-poll-flag t)
+ " "
+ (propertize "NSFW"
+ 'toot-post-nsfw-flag t)
+ " "
+ (propertize "Quoting"
+ 'toot-quote-policy t)
+ "\n"
+ " Attachments: "
+ (propertize "None "
+ 'toot-attachments t)
+ "\n"
+ (cond (reply-text
+ (propertize
+ (mastodon-toot--format-reply-in-compose reply-text)
+ 'toot-reply t))
+ (quote-text
+ (let ((text (mastodon-toot--format-reply-in-compose
+ nil quote-text)))
+ (propertize text
+ 'toot-quote text))))
+ divider)
+ 'face 'mastodon-toot-docs-face
+ 'read-only "Edit your message below."
+ 'toot-post-header t))
+ ;; allow us to enter text after read-only header:
+ (propertize "\n\n"
+ 'rear-nonsticky t))))
+
+(defun mastodon-toot--most-restrictive-visibility (reply-visibility)
+ "Return REPLY-VISIBILITY or default visibility, whichever is more restrictive.
+The default is given by `mastodon-toot--default-reply-visibility'."
+ (unless (null reply-visibility)
+ (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility)
+ mastodon-toot-visibility-list)))
+ (if (member (intern reply-visibility) less-restrictive)
+ reply-visibility
+ mastodon-toot--default-reply-visibility))))
+
+(defun mastodon-toot--render-reply-region-str (str)
+ "Refill STR and prefix all lines with >, as reply-quote text."
+ (with-temp-buffer
+ (insert str)
+ ;; unfill first:
+ (let ((fill-column (point-max)))
+ (fill-region (point-min) (point-max)))
+ ;; then fill:
+ (fill-region (point-min) (point-max))
+ ;; add our own prefix, pauschal:
+ (goto-char (point-min))
+ (save-match-data
+ (while (re-search-forward "^" nil t)
+ (replace-match " > ")))
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id
+ reply-json reply-region)
+ "If REPLY-TO-USER is provided, inject their handle into the message.
+If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'.
+REPLY-JSON is the full JSON of the toot being replied to.
+REPLY-REGION is a string to be injected into the buffer."
+ (let ((reply-visibility (mastodon-toot--most-restrictive-visibility
+ (alist-get 'visibility reply-json)))
+ (reply-cw (alist-get 'spoiler_text reply-json)))
+ (when reply-to-user
+ (when (> (length reply-to-user) 0) ; self is "" unforch
+ (insert (format "%s " reply-to-user)))
+ (when reply-region
+ (insert "\n"
+ (mastodon-toot--render-reply-region-str reply-region)
+ "\n"))
+ (setq mastodon-toot--reply-to-id reply-to-id)
+ (unless (string= mastodon-toot--visibility reply-visibility)
+ (setq mastodon-toot--visibility reply-visibility))
+ (mastodon-toot--set-cw reply-cw))))
+
+(defun mastodon-toot--update-status-fields (&rest _args)
+ "Update the status fields in the header based on the current state."
+ (ignore-errors ;; called from after-change-functions so let's not leak errors
+ (let* ((inhibit-read-only t)
+ (header-region (mastodon-tl--find-property-range 'toot-post-header
+ (point-min)))
+ (count-region (mastodon-tl--find-property-range 'toot-post-counter
+ (point-min)))
+ (vis-region (mastodon-tl--find-property-range
+ 'toot-post-visibility (point-min)))
+ (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag
+ (point-min)))
+ (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag
+ (point-min)))
+ (lang-region (mastodon-tl--find-property-range 'toot-post-language
+ (point-min)))
+ (sched-region (mastodon-tl--find-property-range 'toot-post-scheduled
+ (point-min)))
+ (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag
+ (point-min)))
+ (quote-pol-region (mastodon-tl--find-property-range 'toot-quote-policy
+ (point-min)))
+ (toot-string (buffer-substring-no-properties (cdr header-region)
+ (point-max)))
+ (toot-quote (mastodon-tl--find-property-range 'toot-quote
+ (point-min)))
+ (quote-text (when toot-quote
+ (save-excursion
+ (goto-char (car toot-quote))
+ (mastodon-tl--property 'toot-quote :nomove)))))
+ (mastodon-toot--apply-fields-props
+ count-region
+ (format "%s/%s chars"
+ (mastodon-toot--count-toot-chars toot-string)
+ (number-to-string mastodon-toot--max-toot-chars)))
+ (mastodon-toot--apply-fields-props
+ vis-region
+ (format "%s"
+ (if (string= "private" mastodon-toot--visibility)
+ "followers-only"
+ mastodon-toot--visibility)))
+ ;; WHEN clauses don't work here, we need "" as display arg:
+ (mastodon-toot--apply-fields-props
+ lang-region
+ (if mastodon-toot--language
+ (format "Lang: %s ⋅" mastodon-toot--language)
+ ""))
+ (mastodon-toot--apply-fields-props
+ sched-region
+ (if mastodon-toot--scheduled-for
+ (format "Scheduled: %s ⋅"
+ (mastodon-toot--iso-to-human
+ mastodon-toot--scheduled-for))
+ ""))
+ (mastodon-toot--apply-fields-props
+ nsfw-region
+ (if mastodon-toot--content-nsfw
+ (if mastodon-toot--media-attachments
+ "NSFW" "NSFW (attachments only)")
+ "")
+ 'mastodon-cw-face)
+ (mastodon-toot--apply-fields-props
+ poll-region
+ (if mastodon-toot-poll
+ "POLL"
+ "")
+ 'mastodon-cw-face
+ (prin1-to-string mastodon-toot-poll))
+ (mastodon-toot--apply-fields-props
+ cw-region
+ (if (and mastodon-toot--content-warning
+ (not (string= "" mastodon-toot--content-warning)))
+ (format "CW: %s" mastodon-toot--content-warning)
+ " ") ;; hold the blank space
+ 'mastodon-cw-face)
+ (mastodon-toot--apply-fields-props
+ quote-pol-region
+ (if mastodon-toot-quote-policy
+ (format "Quoting: %s" mastodon-toot-quote-policy)
+ "")
+ 'mastodon-cw-face)
+ (mastodon-toot--apply-fields-props
+ toot-quote quote-text 'mastodon-cw-face))))
+
+(defun mastodon-toot--apply-fields-props (region display &optional face help-echo)
+ "Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end."
+ (add-text-properties (car region) (cdr region)
+ `(display
+ ,display
+ ,@(when face `(face ,face))
+ ,@(when help-echo `(help-echo ,help-echo)))))
+
+(defun mastodon-toot--count-toot-chars (toot-string &optional cw)
+ "Count the characters in TOOT-STRING.
+URLs always = 23, and domain names of handles are not counted.
+This is how mastodon does it.
+CW is the content warning, which contributes to the character count."
+ ;; FIXME: URL chars is avail at /api/v1/instance
+ ;; for masto, it's .statuses.characters_reserved_per_url
+ (let* ((url-replacement (make-string 23 ?x))
+ (count-str
+ (replace-regexp-in-string ; handle @handles
+ mastodon-toot-handle-regex "\\4"
+ (replace-regexp-in-string ; handle URLs
+ mastodon-toot-url-regex url-replacement toot-string))))
+ (+ (length cw)
+ (length count-str))))
+
+\f
+;;; DRAFTS
+
+(defun mastodon-toot--save-toot-text (&rest _args)
+ "Save the current toot text in `mastodon-toot-current-toot-text'.
+Added to `after-change-functions' in new toot buffers."
+ (let ((text (mastodon-toot--remove-docs)))
+ (unless (string-empty-p text)
+ (setq mastodon-toot-current-toot-text text))))
+
+(defun mastodon-toot-open-draft-toot ()
+ "Prompt for a draft and compose a toot with it."
+ (interactive)
+ (if mastodon-toot-draft-toots-list
+ (let ((text (completing-read "Select draft toot: "
+ mastodon-toot-draft-toots-list
+ nil t)))
+ (if (not (mastodon-toot--compose-buffer-p))
+ (mastodon-toot--compose-buffer nil nil nil text)
+ (when (and (not (mastodon-toot--empty-p :text-only))
+ (y-or-n-p "Replace current text with draft?"))
+ (cl-pushnew mastodon-toot-current-toot-text
+ mastodon-toot-draft-toots-list)
+ (goto-char
+ (cdr (mastodon-tl--find-property-range 'toot-post-header
+ (point-min))))
+ (kill-region (point) (point-max))
+ ;; to not save to kill-ring:
+ ;; (delete-region (point) (point-max))
+ (insert text))))
+ (unless (mastodon-toot--compose-buffer-p)
+ (mastodon-toot--compose-buffer))
+ (message "No drafts available.")))
+
+(defun mastodon-toot-delete-draft-toot ()
+ "Prompt for a draft toot and delete it."
+ (interactive)
+ (if (not mastodon-toot-draft-toots-list)
+ (user-error "No drafts to delete")
+ (let ((draft (completing-read "Select draft to delete: "
+ mastodon-toot-draft-toots-list
+ nil t)))
+ (setq mastodon-toot-draft-toots-list
+ (cl-delete draft mastodon-toot-draft-toots-list :test #'equal))
+ (message "Draft deleted!"))))
+
+(defun mastodon-toot-delete-all-drafts ()
+ "Delete all drafts."
+ (interactive)
+ (setq mastodon-toot-draft-toots-list nil)
+ (message "All drafts deleted!"))
+
+\f
+;;; PROPERTIZE TAGS AND HANDLES
+
+(defun mastodon-toot--propertize-tags-and-handles (&rest _args)
+ "Propertize tags and handles in toot compose buffer.
+Added to `after-change-functions'."
+ (when (mastodon-toot--compose-buffer-p)
+ (let ((header-region (mastodon-tl--find-property-range 'toot-post-header
+ (point-min)))
+ (face (when mastodon-toot--proportional-fonts-compose
+ 'variable-pitch)))
+ ;; cull any prev props:
+ ;; stops all text after a handle or mention being propertized:
+ (set-text-properties (cdr header-region) (point-max) `(face ,face))
+ (mastodon-toot--propertize-item mastodon-toot-tag-regex
+ 'success
+ (cdr header-region))
+ (mastodon-toot--propertize-item mastodon-toot-handle-regex
+ 'mastodon-display-name-face
+ (cdr header-region))
+ (mastodon-toot--propertize-item mastodon-toot-url-regex
+ 'link
+ (cdr header-region)))))
+
+(defun mastodon-toot--propertize-item (regex face start)
+ "Propertize item matching REGEX with FACE starting from START."
+ (save-excursion
+ (goto-char start)
+ (cl-loop while (search-forward-regexp regex nil :noerror)
+ do (add-text-properties (match-beginning 2)
+ (match-end 2)
+ `(face ,face)))))
+
+(defun mastodon-toot--compose-buffer-p ()
+ "Return t if compose buffer is current."
+ (or (mastodon-tl--buffer-type-eq 'edit-toot)
+ (mastodon-tl--buffer-type-eq 'new-toot)))
+
+(defun mastodon-toot--fill-reply-in-compose ()
+ "Fill reply text in compose buffer to the width of the divider."
+ (save-excursion
+ (save-match-data
+ (let* ((fill-column 67))
+ (goto-char (point-min))
+ (when-let* ((prop (text-property-search-forward 'toot-reply)))
+ (fill-region (prop-match-beginning prop)
+ (point)))))))
+
+\f
+;;; COMPOSE BUFFER FUNCTION
+
+(defun mastodon-toot--compose-buffer
+ (&optional reply-to-user reply-to-id reply-json initial-text edit
+ quote-id quote-json visibility)
+ "Create a new buffer to capture text for a new toot.
+If REPLY-TO-USER is provided, inject their handle into the message.
+If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var.
+REPLY-JSON is the full JSON of the toot being replied to.
+INITIAL-TEXT is used by `mastodon-toot-insert-draft-toot' to add
+a draft into the buffer.
+EDIT means we are editing an existing toot, not composing a new one.
+QUOTE-ID is the id of the post being quoted if there is one.
+QUOTE-JSON is its data.
+VISIBILITY is the toot's visibility."
+ (let* ((buffer-name (if edit "*edit toot*" "*new toot*"))
+ (buffer-exists (get-buffer buffer-name))
+ (buffer (if (not buffer-exists)
+ (get-buffer-create buffer-name)
+ ;; if a user hits reply while a compose buffer is already
+ ;; open, we really ought to wipe it all and start over.
+ (switch-to-buffer-other-window buffer-exists)
+ (if (not (y-or-n-p "Overwrite existing compose buffer?"))
+ (user-error "Aborting")
+ (kill-buffer-and-window)
+ (get-buffer-create buffer-name))))
+ (inhibit-read-only t)
+ (reply-text (alist-get 'content
+ (or (alist-get 'reblog reply-json)
+ reply-json)))
+ (previous-window-config (list (current-window-configuration)
+ (point-marker))))
+ (switch-to-buffer-other-window buffer)
+ (text-mode)
+ (mastodon-toot-mode t)
+ ;; set quote id:
+ (when quote-id
+ (setq mastodon-toot-quote-id quote-id))
+ ;; set visibility:
+ (setq mastodon-toot--visibility
+ (or visibility ;; quoting a toot
+ (plist-get mastodon-profile-account-settings 'privacy)
+ ;; use toot visibility setting from the server:
+ (mastodon-profile--get-source-value 'privacy)
+ "public")) ; fallback
+ ;; default language:
+ ;; NB: this is not necessarily set in
+ ;; `mastodon-profile-credential-account' nor in
+ ;; `mastodon-profile-account-settings'!
+ (setq mastodon-toot--language
+ (mastodon-profile--get-preferences-pref 'posting:default:language))
+ ;; display original toot:
+ (cond (quote-id
+ (mastodon-toot--display-docs-and-status-fields
+ nil (mastodon-tl--field 'content quote-json))
+ (mastodon-toot--fill-reply-in-compose))
+ (mastodon-toot-display-orig-in-reply-buffer
+ (mastodon-toot--display-docs-and-status-fields reply-text)
+ (mastodon-toot--fill-reply-in-compose))
+ (t (mastodon-toot--display-docs-and-status-fields)))
+ ;; `reply-to-user' (alone) is also used by `mastodon-tl-dm-user', so
+ ;; perhaps we should not always call --setup-as-reply, or make its
+ ;; workings conditional on reply-to-id. currently it only checks for
+ ;; reply-to-user.
+ (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json
+ ;; only initial-text if reply (not edit):
+ (when reply-json initial-text))
+ (unless mastodon-toot--max-toot-chars
+ ;; no need to fetch from `mastodon-profile-account-settings' as
+ ;; `mastodon-toot--max-toot-chars' is set when we set it
+ (mastodon-toot--get-max-toot-chars))
+ ;; set up completion:
+ (setq-local completion-ignore-case t)
+ (when mastodon-toot--enable-completion
+ (set (make-local-variable 'completion-at-point-functions)
+ (add-to-list 'completion-at-point-functions
+ #'mastodon-toot--mentions-capf))
+ (add-to-list 'completion-at-point-functions
+ #'mastodon-toot--tags-capf)
+ (add-to-list 'completion-at-point-functions
+ #'mastodon-toot--emoji-capf)
+ ;; company
+ (when (and mastodon-toot--use-company-for-completion
+ (require 'company nil :no-error))
+ (declare-function company-mode-on "company")
+ (set (make-local-variable 'company-backends)
+ (add-to-list 'company-backends 'company-capf))
+ (company-mode-on)))
+ ;; after-change:
+ (make-local-variable 'after-change-functions)
+ (cl-pushnew #'mastodon-toot--save-toot-text after-change-functions)
+ (cl-pushnew #'mastodon-toot--update-status-fields after-change-functions)
+ (mastodon-toot--update-status-fields)
+ (cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions)
+ (mastodon-toot--propertize-tags-and-handles)
+ (mastodon-toot--refresh-attachments-display)
+ ;; draft toot text saving:
+ (setq mastodon-toot-current-toot-text nil)
+ ;; if we set this before changing modes, it gets nuked:
+ (setq mastodon-toot-previous-window-config previous-window-config)
+ (when mastodon-toot--proportional-fonts-compose
+ (facemenu-set-face 'variable-pitch))
+ (when (and mastodon-use-emojify
+ ;; emojify loaded but poss not enabled in our buffer:
+ (boundp 'emojify-mode))
+ (emojify-mode))
+ (when (and initial-text
+ (not reply-json))
+ (insert initial-text))))
+
+;; flyspell ignore masto toot regexes:
+(defvar flyspell-generic-check-word-predicate)
+
+(defun mastodon-toot-mode-flyspell-verify ()
+ "A predicate function for `flyspell'.
+Only text that is not one of these faces will be spell-checked."
+ (let ((faces '(mastodon-display-name-face
+ mastodon-toot-docs-face font-lock-comment-face
+ success link)))
+ (unless (eql (point) (point-min))
+ ;; (point) is next char after the word. Must check one char before.
+ (let ((f (get-text-property (1- (point)) 'face)))
+ (not (memq f faces))))))
+
+(defun mastodon-toot-mode-hook-fun ()
+ "Function for code to run in `mastodon-toot-mode-hook'."
+ ;; disable auto-fill-mode:
+ (auto-fill-mode -1)
+ ;; add flyspell predicate function:
+ (setq flyspell-generic-check-word-predicate
+ #'mastodon-toot-mode-flyspell-verify))
+
+(add-hook 'mastodon-toot-mode-hook #'mastodon-toot-mode-hook-fun)
+
+;;;###autoload
+(add-hook 'mastodon-toot-mode-hook
+ #'mastodon-profile--fetch-server-account-settings-maybe)
+
+
+(define-minor-mode mastodon-toot-mode
+ "Minor mode for composing toots."
+ :keymap mastodon-toot-mode-map
+ :global nil)
+
+(provide 'mastodon-toot)
+;;; mastodon-toot.el ends here
--- /dev/null
+;;; mastodon-transient.el --- transient menus for mastodon.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 martian hiatus
+
+;; Author: martian hiatus <mousebotNOSPAMdisroot.org>
+;; Keywords: convenience
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'transient)
+(require 'tp)
+
+(defvar mastodon-active-user)
+(defvar mastodon-toot-visibility-settings-list)
+(defvar mastodon-iso-639-regional)
+(defvar mastodon-toot-poll)
+
+(autoload 'mastodon-toot-visibility-settings-list "mastodon-toot")
+(autoload 'mastodon-http--get-json "mastodon-http")
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--triage "mastodon-http")
+(autoload 'mastodon-http--patch "mastodon-http")
+(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile")
+(autoload 'mastodon-toot--fetch-max-poll-options "mastodon-toot")
+(autoload 'mastodon-toot--fetch-max-poll-option-chars "mastodon-toot")
+(autoload 'mastodon-instance-data "mastodon")
+(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
+(autoload 'mastodon-toot--read-poll-expiry "mastodon-toot")
+(autoload 'mastodon-toot--poll-expiry-options-alist "mastodon-toot")
+(autoload 'mastodon-toot-clear-poll "mastodon-toot")
+(autoload 'mastodon-notifications-get-policy "mastodon-notifications")
+
+;;; UTILS
+
+(transient-define-suffix mastodon-transient--prefix-inspect ()
+ "Inspect a transient prefix's arguments and scope."
+ (interactive)
+ :transient 'transient--do-return
+ (let ((args (transient-args (oref transient-current-prefix command)))
+ (scope (oref transient-current-prefix scope)))
+ (message "prefix's scope: %s \ntransient-args: %s\n last: %s"
+ scope args
+ (length
+ (cl-member-if
+ (lambda (x)
+ (equal (car x) 'one))
+ args)))))
+
+;; some JSON fields that are returned under the "source" field need to be
+;; sent back in the format source[key], while some others are sent kust as
+;; key:
+(defun mastodon-transient-parse-source-key (key)
+ "Parse mastodon source KEY.
+If KEY needs to be source[key], format like so, else just return
+the inner key part."
+ (let* ((split (split-string key "[][]"))
+ (array-key (cadr split)))
+ (if (or (= 1 (length split)) ;; no split
+ (member array-key
+ '("quote_policy" "privacy" "sensitive" "language")))
+ key
+ array-key)))
+
+(defun mastodon-transient-parse-source-keys (alist)
+ "Parse ALIST containing source[key] keys."
+ (cl-loop for a in alist
+ collect (cons (mastodon-transient-parse-source-key (car a))
+ (cdr a))))
+
+(defun mastodon-transient-get-creds ()
+ "Fetch account data."
+ (mastodon-http--get-json
+ (mastodon-http--api "accounts/verify_credentials")
+ nil :silent))
+
+;; fields utils:
+;; to PATCH fields, we just need fields[x][name] and fields[x][value]
+
+(defun mastodon-transient--fields-alist (fields)
+ "Convert fields in FIELDS to numbered conses.
+The keys in the data are not numbered, so we convert the key into
+the format fields.X.keyname."
+ (cl-loop
+ for f in fields
+ for count from 1 to 5
+ collect
+ (cl-loop for x in f
+ collect
+ (cons (concat "fields." (number-to-string count)
+ "." (symbol-name (car x)))
+ (cdr x)))))
+
+(defun mastodon-transient-field-dot-to-array (key)
+ "Convert KEY from tp dot annotation to array[key] annotation."
+ (tp-dot-to-array (symbol-name key) nil "_attributes"))
+
+(defun mastodon-transient-dot-fields-to-arrays (alist)
+ "Parse fields ALIST in dot notation to array notation."
+ (cl-loop for y in alist
+ collect
+ (cons (mastodon-transient-field-dot-to-array (car y))
+ (cdr y))))
+
+;;; TRANSIENTS
+
+;; FIXME: PATCHing source vals as JSON request body doesn't work! existing
+;; `mastodon-profile--update-preference' doesn't use it! it just uses
+;; query params! strange thing is it works for non-source params
+(transient-define-suffix mastodon-user-settings-update (&optional args)
+ "Update current user settings on the server."
+ :transient 'transient--do-exit
+ (interactive (list (transient-args 'mastodon-user-settings)))
+ (let* ((parsed (tp-parse-args-for-send args :strings))
+ (strs (mastodon-transient-parse-source-keys parsed))
+ (url (mastodon-http--api "accounts/update_credentials"))
+ (resp (mastodon-http--patch url strs))) ;; :json fails
+ (mastodon-http--triage
+ resp
+ (lambda (_resp)
+ (message "Settings updated!\n%s" (pp-to-string strs))))))
+
+(transient-define-prefix mastodon-user-settings ()
+ "A transient for setting current user settings."
+ :value (lambda () (tp-return-data
+ #'mastodon-transient-get-creds))
+ [:description
+ (lambda ()
+ (format "User settings for %s" mastodon-active-user))
+ (:info
+ "Note: use the empty string (\"\") to remove a value from an option.")]
+ ;; strings
+ ["Account info"
+ ("n" "display name" "display_name" :alist-key display_name :class tp-option-str)
+ ("t" "update profile note" mastodon-update-profile-note)
+ ("f" "update profile fields" mastodon-profile-fields)]
+ ;; "choice" booleans (so we can PATCH :json-false explicitly):
+ ["Account options"
+ ("l" "locked" "locked" :alist-key locked :class tp-bool)
+ ("b" "bot" "bot" :alist-key bot :class tp-bool)
+ ("d" "discoverable" "discoverable" :alist-key discoverable :class tp-bool)
+ ("c" "hide follower/following lists" "source.hide_collections"
+ :alist-key source.hide_collections :class tp-bool)
+ ("i" "indexable" "source.indexable" :alist-key source.indexable :class tp-bool)]
+ ["Tooting options"
+ ("p" "default privacy" "source.privacy" :alist-key source.privacy
+ :class tp-option
+ :choices (lambda () mastodon-toot-visibility-settings-list))
+ ("s" "mark sensitive" "source.sensitive" :alist-key source.sensitive :class tp-bool)
+ ("g" "default language" "source.language" :alist-key source.language :class tp-option
+ :choices (lambda () mastodon-iso-639-regional))
+ ("q" "quote policy" "source.quote_policy" :alist-key source.quote_policy
+ :class tp-option
+ :choices (lambda () mastodon-profiles-quote-policy-types))]
+ ["Update"
+ ("C-c C-c" "Save settings" mastodon-user-settings-update)
+ ("C-x C-k" :info "Revert all changes")]
+ (interactive)
+ (if (or (not (boundp 'mastodon-active-user))
+ (not mastodon-active-user))
+ (user-error "User not set")
+ (transient-setup 'mastodon-user-settings)))
+
+(transient-define-suffix mastodon-update-profile-note ()
+ "Update current user profile note."
+ :transient 'transient--do-exit
+ (interactive)
+ (mastodon-profile-update-user-profile-note))
+
+(transient-define-suffix mastodon-profile-fields-update (args)
+ "Update current user profile fields."
+ :transient 'transient--do-return
+ (interactive (list (transient-args 'mastodon-profile-fields)))
+ (let* (;; FIXME: maybe only changed also won't work with fields, as
+ ;; perhaps what is PATCHed overwrites whatever is on the server?
+ ;; (only-changed (tp-only-changed-args alist))
+ (arrays (mastodon-transient-dot-fields-to-arrays args))
+ (endpoint "accounts/update_credentials")
+ (url (mastodon-http--api endpoint))
+ (resp (mastodon-http--patch url arrays))) ; :json)))
+ (mastodon-http--triage
+ resp (lambda (_resp) (message "Fields updated!")))))
+
+(defun mastodon-transient-fetch-fields ()
+ "Fetch profile fields (metadata)."
+ (tp-return-data #'mastodon-transient-get-creds nil 'fields)
+ (setq tp-transient-settings
+ (mastodon-transient--fields-alist tp-transient-settings)))
+
+(transient-define-prefix mastodon-profile-fields ()
+ "A transient for setting profile fields."
+ :value (lambda () (mastodon-transient-fetch-fields))
+ [:description
+ "Fields"
+ ["Name"
+ ("1 n" "" "fields.1.name" :alist-key fields.1.name :class mastodon-transient-field)
+ ("2 n" "" "fields.2.name" :alist-key fields.2.name :class mastodon-transient-field)
+ ("3 n" "" "fields.3.name" :alist-key fields.3.name :class mastodon-transient-field)
+ ("4 n" "" "fields.4.name" :alist-key fields.4.name :class mastodon-transient-field)]
+ ["Value"
+ ("1 v" "" "fields.1.value" :alist-key fields.1.value :class mastodon-transient-field)
+ ("2 v" "" "fields.2.value" :alist-key fields.2.value :class mastodon-transient-field)
+ ("3 v" "" "fields.3.value" :alist-key fields.3.value :class mastodon-transient-field)
+ ("4 v" "" "fields.4.value" :alist-key fields.4.value :class mastodon-transient-field)]]
+ ["Update"
+ ("C-c C-c" "Save settings" mastodon-profile-fields-update)
+ ("C-x C-k" :info "Revert all changes")]
+ (interactive)
+ (if (not mastodon-active-user)
+ (user-error "User not set")
+ (transient-setup 'mastodon-profile-fields)))
+
+(defun mastodon-transient-max-poll-opts ()
+ "Return max poll options of user's instance."
+ (let ((instance (mastodon-instance-data)))
+ (mastodon-toot--fetch-max-poll-options instance)))
+
+(defun mastodon-transient-max-poll-opt-chars ()
+ "Return max poll option characters of user's instance."
+ (let ((instance (mastodon-instance-data)))
+ (mastodon-toot--fetch-max-poll-option-chars instance)))
+
+(transient-define-suffix mastodon-transient-choice-add ()
+ "Add another poll choice if possible.
+Do not add more than 9 choices.
+Do not add more than the server's maximum setting."
+ (interactive)
+ :transient 'transient--do-stay
+ (let* ((args (transient-args (oref transient-current-prefix command)))
+ (choice-count (length
+ (cl-member-if
+ (lambda (x)
+ (equal (car x) 'one))
+ args)))
+ (inc (1+ choice-count))
+ (next (number-to-string inc))
+ (next-symbol (pcase inc
+ (5 'five)
+ (6 'six)
+ (7 'seven)
+ (8 'eight)
+ (9 'nine))))
+ (if (or (>= choice-count (mastodon-transient-max-poll-opts))
+ (= choice-count 9))
+ ;; FIXME when we hit '10', we get a binding clash with '1'. :/
+ (message "Max choices reached")
+ (transient-append-suffix
+ 'mastodon-create-poll
+ '(2 -1)
+ `(,next "" ,next
+ :class mastodon-transient-poll-choice
+ :alist-key ,next-symbol
+ :transient t))))
+ (transient-setup 'mastodon-create-poll))
+
+(transient-define-prefix mastodon-create-poll ()
+ "A transient for creating a poll."
+ :value (lambda ()
+ ;; we set `tp-transient-settings' here to the poll value poss
+ ;; pulled from the server by
+ ;; `mastodon-toot--server-poll-to-local'. when we are done with
+ ;; the transient, we set `mastodon-toot-poll' again
+ (setq tp-transient-settings mastodon-toot-poll))
+ ["Create poll"
+ (:info (lambda ()
+ (format "Max options: %s"
+ (mastodon-transient-max-poll-opts))))
+ (:info (lambda ()
+ (format "Max option length: %s"
+ (mastodon-transient-max-poll-opt-chars))))]
+ ["Options"
+ ("m" "Multiple choice?" "multi" :alist-key multi
+ :class mastodon-transient-poll-bool)
+ ("h" "Hide vote count till expiry?" "hide" :alist-key hide
+ :class mastodon-transient-poll-bool)
+ ("e" "Expiry" "expiry" :alist-key expiry
+ :class mastodon-transient-expiry)]
+ ["Choices"
+ ("1" "" "1" :alist-key one :class mastodon-transient-poll-choice)
+ ("2" "" "2" :alist-key two :class mastodon-transient-poll-choice)
+ ("3" "" "3" :alist-key three :class mastodon-transient-poll-choice)
+ ("4" "" "4" :alist-key four :class mastodon-transient-poll-choice)]
+ ;; TODO: display the max number of options or add options cmd
+ ["Update"
+ ("C-c C-s" "Add another poll choice" mastodon-transient-choice-add
+ :if (lambda () (< 4 (mastodon-transient-max-poll-opts))))
+ ("C-c C-c" "Save and done" mastodon-create-poll-done)
+ ("C-x C-k" :info "Revert all")
+ ("C-c C-k" "Delete all" mastodon-clear-poll)]
+ (interactive)
+ (if (not mastodon-active-user)
+ (user-error "User not set")
+ (transient-setup 'mastodon-create-poll)))
+
+(transient-define-suffix mastodon-clear-poll ()
+ "Clear current poll data."
+ :transient 'transient--do-stay
+ (interactive)
+ (mastodon-toot-clear-poll :transient)
+ (transient-reset))
+
+(transient-define-suffix mastodon-create-poll-done (args)
+ "Finish setting poll details."
+ :transient 'transient--do-exit
+ (interactive (list (transient-args 'mastodon-create-poll)))
+ (let* ((options (cl-member-if (lambda (x)
+ (eq (car x) 'one))
+ args))
+ (opt-vals (cl-loop for x in options
+ collect (cdr x)))
+ (lengths (mapcar #'length opt-vals))
+ (vals (cl-remove 'nil
+ (cl-loop for x in args
+ collect (cdr x))))
+ (opts-count (length (cl-remove 'nil opt-vals))))
+ ;; this way of checking gets annoying if we want to just cancel out of
+ ;; the poll (but to actually cancel user should C-g, not C-c C-c):
+ (if (or (and (< 50 (apply #'max lengths))
+ (not (y-or-n-p "Options longer than server max. Proceed? ")))
+ (and (not (alist-get 'expiry args))
+ (not (y-or-n-p "No expiry. Proceed? ")))
+ (and (not (< 1 opts-count))
+ (not (y-or-n-p "Need more than one option. Proceed? ")))
+ (and (> opts-count (mastodon-transient-max-poll-opts))
+ (not (y-or-n-p "More options than server max. Proceed? "))))
+ (call-interactively #'mastodon-create-poll)
+ ;; if we are called with no poll data, do not set:
+ (unless (not vals)
+ ;; we set `mastodon-toot-poll' here not `tp-transient-settings'
+ ;; as that is our var outside of our transient:
+ (setq mastodon-toot-poll
+ (tp-bools-to-strs args)))
+ (mastodon-toot--update-status-fields))))
+
+(defvar mastodon-notifications-policy-vals)
+(declare-function mastodon-notifications-get-policy "mastodon-notifications")
+(declare-function mastodon-notifications--update-policy "mastodon-notifications")
+
+(transient-define-prefix mastodon-notifications-policy ()
+ "A transient to set notifications policy options."
+ ;; https://docs.joinmastodon.org/methods/notifications/#get-policy
+ :value (lambda () (tp-return-data #'mastodon-notifications-get-policy))
+ ["Notification policy options"
+ ("f" "people you don't follow" "for_not_following"
+ :alist-key for_not_following :class mastodon-transient-policy)
+ ("F" "people not following you" "for_not_followers"
+ :alist-key for_not_followers :class mastodon-transient-policy)
+ ("n" "New accounts" "for_new_accounts"
+ :alist-key for_new_accounts :class mastodon-transient-policy)
+ ("p" "Unsolicited private mentions" "for_private_mentions"
+ :alist-key for_private_mentions :class mastodon-transient-policy)
+ ("l" "Moderated accounts" "for_limited_accounts"
+ :alist-key for_limited_accounts :class mastodon-transient-policy)
+ (:info "")
+ (:info "\"accept\" = receive notifications")
+ (:info "\"filter\" = mark as filtered")
+ (:info "\"drop\" = do not receive any notifications")]
+ ["Notification requests"
+ (:info #'mastodon-notifications-requests-count)
+ (:info #'mastodon-notifications-filtered-count)]
+ ["Update"
+ ("C-c C-c" "Save settings" mastodon-notifications-policy-update)
+ ("C-x C-k" :info "Revert all changes")])
+
+(defun mastodon-notifications-requests-count ()
+ "Format a string for pending requests."
+ (let ((val ;; (oref transient--prefix value))) ;; deprecated
+ ;; (transient-get-value)) ;; broken
+ tp-transient-settings)) ;; dubious
+ (format "Pending requests: %d"
+ (or (map-nested-elt
+ val
+ '(summary pending_requests_count))
+ 0))))
+
+(defun mastodon-notifications-filtered-count ()
+ "Format a string for pending notifications."
+ (let ((val ;; (oref transient--prefix value))) ;; deprecated
+ ;; (transient-get-value)) ;; broken
+ tp-transient-settings)) ;; dubious
+ (format "Pending notifications: %d"
+ (or (map-nested-elt
+ val
+ '(summary pending_notifications_count))
+ 0))))
+
+(transient-define-suffix mastodon-notifications-policy-update (args)
+ "Send updated notification policy settings."
+ :transient 'transient--do-exit
+ ;; TODO:
+ (interactive (list (transient-args 'mastodon-notifications-policy)))
+ (let* ((parsed (tp-parse-args-for-send args))
+ (resp (mastodon-notifications--update-policy parsed)))
+ (mastodon-http--triage
+ resp
+ (lambda (_resp)
+ (message "Settings updated!\n%s" (pp-to-string parsed))))))
+
+;;; CLASSES
+
+(defclass mastodon-transient-policy (tp-cycle)
+ ((choices :initarg :choices :initform 'mastodon-notifications-policy-vals))
+ "An option class for mastodon notification policy options.")
+
+(defclass mastodon-transient-field (tp-option-str)
+ ((always-read :initarg :always-read :initform t))
+ "An infix option class for our options.
+We always read.")
+
+(cl-defmethod transient-init-value ((obj mastodon-transient-field))
+ "Initialize value of OBJ."
+ (let* ((prefix-val ;; (oref transient--prefix value))) ;; deprecated
+ ;; (transient-get-value)) ;; broken
+ tp-transient-settings)) ;; dubious
+ ;; (arg (oref obj alist-key)))
+ (oset obj value
+ (tp-get-server-val obj prefix-val))))
+
+(cl-defmethod tp-get-server-val ((obj mastodon-transient-field) data)
+ "Return the server value for OBJ from DATA.
+If OBJ's key has dotted notation, drill down into the alist. Currently
+only one level of nesting is supported."
+ ;; TODO: handle nested alist keys
+ (let* ((key (oref obj alist-key))
+ (split (split-string (symbol-name key) "\\."))
+ (num (string-to-number (cadr split))))
+ (alist-get key
+ (nth (1- num) data) nil nil #'string=)))
+
+(cl-defmethod tp-arg-changed-p ((_obj mastodon-transient-field) cons)
+ "T if value of OBJ is changed from the server value.
+CONS is a cons of the form \"(fields.1.name . val)\"."
+ (let* ((key-split (split-string
+ (symbol-name (car cons)) "\\."))
+ (num (1- (string-to-number (nth 1 key-split))))
+ (server-key (symbol-name (car cons)))
+ (server-elt (nth num tp-transient-settings)))
+ (not (equal (cdr cons)
+ (alist-get server-key server-elt nil nil #'string=)))))
+
+(defclass mastodon-transient-opt (tp-option tp-option-var)
+ (()))
+
+(defclass mastodon-transient-poll-bool (tp-bool tp-option-var)
+ ())
+
+(defclass mastodon-transient-poll-choice (tp-option-str tp-option-var)
+ ())
+
+(cl-defmethod transient-infix-read ((obj mastodon-transient-poll-choice))
+ "Reader function for OBJ, a poll expiry."
+ (let* ((value (transient-infix-value obj))
+ (prompt (transient-prompt obj))
+ (str (read-string prompt (cdr value)))
+ (max (mastodon-transient-max-poll-opt-chars)))
+ (if (not (> (length str) max))
+ str
+ (if (not
+ (y-or-n-p
+ (format "Poll option too long for server (%s/%s chars), retry?"
+ (length str) max)))
+ str
+ (oset obj value str)
+ (transient-infix-read obj)))))
+
+(defclass mastodon-transient-expiry (tp-option tp-option-var)
+ ())
+
+(cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry))
+ "Reader function for OBJ, a poll expiry."
+ (cdr (mastodon-toot--read-poll-expiry)))
+
+(cl-defmethod transient-format-value ((obj mastodon-transient-expiry))
+ "Format function for OBJ, a poll expiry."
+ (let* ((cons (transient-infix-value obj))
+ (value (when cons (cdr cons))))
+ (if (not value)
+ ""
+ (let ((readable
+ (or (car
+ (rassoc value
+ (mastodon-toot--poll-expiry-options-alist)))
+ (concat value " secs")))) ;; editing a poll wont match expiry list
+ (propertize readable
+ 'face (if (tp-arg-changed-p obj cons)
+ 'transient-value
+ 'transient-inactive-value))))))
+
+(provide 'mastodon-transient)
+;;; mastodon-transient.el ends here
--- /dev/null
+;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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)
+(eval-when-compile
+ (require 'mastodon-tl))
+
+(defvar mastodon-mode-map)
+(defvar mastodon-tl--horiz-bar)
+(defvar mastodon-tl--timeline-posts-count)
+
+(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-first-item "mastodon-tl")
+(autoload 'mastodon-tl--do-if-item "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")
+
+\f
+;;; 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 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)
+ 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 "g") #'mastodon-views-view-filters)
+ (define-key map (kbd "u") #'mastodon-views-update-filter)
+ (define-key map (kbd "k") #'mastodon-views-delete-filter)
+ (define-key map (kbd "a") #'mastodon-views-add-filter-kw)
+ (define-key map (kbd "r") #'mastodon-views-remove-filter-kw)
+ (define-key map (kbd "U") #'mastodon-views-update-filter-kw)
+ 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)
+ (define-key map (kbd "g") #'mastodon-views-view-lists)
+ 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)
+ (define-key map (kbd "g") #'mastodon-views-view-scheduled-toots)
+ 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.")
+
+\f
+;;; GENERAL FUNCTION
+
+(defun mastodon-views--minor-view (view-name 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."
+ ;; FIXME not tecnically an update-fun for init-sync, but just a simple way
+ ;; to set up the empty buffer or else call the insert-fun. not sure if we cd
+ ;; improve by eg calling init-sync in here, making this a real view function.
+ (if (seq-empty-p data)
+ (insert (propertize
+ (format "Looks like you have no %s for now." view-name)
+ 'face 'mastodon-toot-docs-face
+ 'byline t
+ 'item-type 'no-item ; for nav
+ 'item-id "0")) ; so point can move here when no item
+ (funcall insert-fun data)
+ (goto-char (point-min)))
+ ;; (when data
+ ;; FIXME: this seems to trigger a new request, but ideally would run.
+ ;; (mastodon-tl-goto-next-item))
+ )
+
+\f
+;;; 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
+ nil nil nil
+ "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")
+ (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
+ "lists"
+ #'mastodon-views--print-list-set
+ json))
+
+(defun mastodon-views--print-list-set (lists)
+ "Print each account plus a separator for each list in LISTS."
+ (cl-loop for x in lists
+ do (progn
+ (mastodon-views--print-list-accounts x)
+ (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n")
+ 'face 'success)))))
+
+(defun mastodon-views--print-list-accounts (list)
+ "Insert the accounts in list named LIST, an alist."
+ (let-alist list
+ (let* ((accounts (mastodon-views--accounts-in-list .id)))
+ (insert
+ (propertize .title
+ 'byline t ; so we nav here
+ 'item-id "0" ; so we nav here
+ 'item-type 'list
+ '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 .title
+ 'list-id .id)
+ (propertize (format " [replies: %s, exclusive %s]"
+ .replies_policy
+ (when (eq t .exclusive) "true"))
+ 'face 'mastodon-toot-docs-face)
+ (propertize "\n\n"
+ 'list t
+ 'keymap mastodon-views--list-name-keymap
+ 'list-name .title
+ 'list-id .id)
+ (propertize
+ (mapconcat #'mastodon-search--propertize-user accounts
+ " ")
+ 'list t
+ 'keymap mastodon-views--list-name-keymap
+ 'list-name .title
+ '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"))
+ (exclusive (if (y-or-n-p "Exclude items from home timeline? ")
+ "true"
+ "false"))
+ (url (mastodon-http--api (format "lists/%s" id)))
+ (response (mastodon-http--put url
+ `(("title" . ,name-choice)
+ ("replies_policy" . ,replies-policy)
+ ("exclusive" . ,exclusive)))))
+ (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 nil
+ `(("limit" . ,mastodon-tl--timeline-posts-count)))))
+
+(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
+ (exclusive (when (y-or-n-p "Exclude items from home timeline? ")
+ "true"))
+ (response (mastodon-http--post
+ (mastodon-http--api "lists")
+ `(("title" . ,title)
+ ("replies_policy" . ,replies-policy)
+ ("exclusive" . ,exclusive)))))
+ (mastodon-views--list-action-triage
+ response "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 "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 (unless handle
+ (mastodon-views--get-users-followings)))
+ (handles (unless handle
+ (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)))
+ (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 "%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 'item-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))
+ (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 "%s removed from list %s!" account list-name)))
+
+(defun mastodon-views--list-action-triage (response &rest args)
+ "Call `mastodon-http--triage' on RESPONSE and call message on ARGS."
+ (mastodon-http--triage response
+ (lambda (_)
+ (when (mastodon-tl--buffer-type-eq 'lists)
+ (mastodon-views-view-lists))
+ (apply #'message args))))
+
+(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)))
+
+\f
+;;; 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"
+ #'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
+ nil
+ '(("limit" . "40")) ; server max is 80
+ :headers
+ "follow requests"
+ "a/j - accept/reject request at point\n\
+ n/p - go to next/prev request")
+ (mastodon-tl--goto-first-item)
+ (with-current-buffer "*mastodon-follow-requests*"
+ (use-local-map mastodon-views--view-follow-requests-keymap)))
+
+\f
+;;; SCHEDULED TOOTS
+
+;;;###autoload
+(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
+ nil nil nil
+ "your scheduled toots"
+ "n/p - prev/next\n r - reschedule\n\
+ e/RET - edit toot\n c - cancel")
+ (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
+ "scheduled toots"
+ #'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-alist toot
+ (insert
+ (propertize (concat (string-trim .params.text)
+ " | "
+ (mastodon-toot--iso-to-human .scheduled_at))
+ 'byline t ; so we nav here
+ 'item-type 'scheduled ; so we nav here
+ 'face 'mastodon-toot-docs-face
+ 'keymap mastodon-views--scheduled-map
+ 'item-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)
+ (mastodon-tl--do-if-item
+ (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)
+ (mastodon-tl--do-if-item
+ (when (or no-confirm
+ (y-or-n-p "Cancel scheduled toot?"))
+ (let* ((id (or id (mastodon-tl--property 'id :no-move)))
+ (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)
+ (mastodon-tl--do-if-item
+ (let* ((toot (mastodon-tl--property 'scheduled-json :no-move))
+ (id (mastodon-tl--property 'id :no-move))
+ (scheduled (alist-get 'scheduled_at toot)))
+ (let-alist (alist-get 'params toot)
+ ;; TODO: preserve polls
+ ;; (poll (alist-get 'poll params))
+ (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit)
+ (goto-char (point-max))
+ ;; adopt properties from scheduled toot:
+ (mastodon-toot--set-toot-properties
+ .in_reply_to_id .visibility .spoiler_text .language
+ scheduled id (alist-get 'media_attachments toot))))))
+
+\f
+;;; FILTERS
+
+;;;###autoload
+(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
+ nil nil nil
+ "current filters"
+ "c/u - create/update filter | d/k - delete filter\
+ at point\n a/r/U - add/remove/Update filter keyword\n\
+ n/p - next/prev filter" "v2")
+ (with-current-buffer "*mastodon-filters*"
+ (use-local-map mastodon-views--view-filters-keymap)))
+
+(defun mastodon-views--insert-filters (json)
+ "Insert a filter string plus a blank line.
+JSON is the filters data."
+ (mapc #'mastodon-views--insert-filter json))
+
+(require 'table)
+
+(defun mastodon-views--insert-filter-kws (kws)
+ "Insert filter keywords KWS."
+ (insert "\n")
+ (let ((beg (point))
+ (table-cell-horizontal-chars (if (char-displayable-p ?–)
+ "–"
+ "-"))
+ (whole-str "whole words only:"))
+ (insert (concat "Keywords: | " whole-str "\n"))
+ (cl-loop for kw in kws
+ do (let ((whole (if (eq :json-false (alist-get 'whole_word kw))
+ "nil"
+ "t")))
+ (insert
+ (propertize (concat
+ (format "\"%s\" | %s\n"
+ (alist-get 'keyword kw) whole))
+ 'kw-id (alist-get 'id kw)
+ 'item-json kw
+ 'mastodon-tab-stop t
+ 'whole-word whole))))
+ ;; table display of kws:
+ (table-capture beg (point) "|" "\n" nil (+ 2 (length whole-str)))
+ (table-justify-column 'center)
+ (table-forward-cell) ;; col 2
+ (table-justify-column 'center)
+ (mastodon-views--end-of-table)))
+
+(defun mastodon-views--end-of-table ()
+ ""
+ (while (re-search-forward ;; goto end of table:
+ (concat table-cell-horizontal-chars
+ (make-string 1 table-cell-intersection-char)
+ "\n")
+ nil :no-error)))
+
+(defun mastodon-views--insert-filter (filter)
+ "Insert a single FILTER."
+ (let-alist filter
+ (insert
+ ;; FIXME: awful hack to fix nav: exclude horiz-bar from propertize then
+ ;; propertize rest of the filter text. if we add only byline prop to
+ ;; title, point will move to end of title, because at that byline-prop
+ ;; change, item-type prop is present.
+ (mastodon-tl--set-face
+ (concat "\n " mastodon-tl--horiz-bar "\n ")
+ 'success)
+ (propertize
+ (concat
+ ;; heading:
+ (mastodon-tl--set-face
+ (concat (upcase .title) " " "\n "
+ mastodon-tl--horiz-bar "\n")
+ 'success)
+ ;; context:
+ (concat "Context: " (mapconcat #'identity .context ", "))
+ ;; type (warn or hide):
+ (concat "\nType: " .filter_action))
+ 'item-json filter
+ 'byline t
+ 'item-id .id
+ 'filter-title .title
+ 'item-type 'filter))
+ ;; terms list:
+ (when .keywords ;; poss to have no keywords
+ (mastodon-views--insert-filter-kws .keywords))))
+
+(defvar mastodon-views--filter-types
+ '("home" "notifications" "public" "thread" "profile"))
+
+(defun mastodon-views-create-filter (&optional id title context type terms)
+ "Create a filter for a word.
+Prompt for a context, must be a list containting at least one of \"home\",
+\"notifications\", \"public\", \"thread\".
+Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter."
+ (interactive)
+ ;; ID non-nil = we are updating
+ (let* ((url (mastodon-http--api-v2
+ (if id (format "filters/%s" id) "filters")))
+ (title (or title (read-string "Filter name: ")))
+ (terms (or terms
+ (read-string "Terms to filter (comma or space separated): ")))
+ (terms-split (split-string terms "[, ]"))
+ (terms-processed
+ (if (not terms) ;; well actually it is poss to have no terms
+ (user-error "You must select at least one term")
+ (mastodon-http--build-array-params-alist
+ "keywords_attributes[][keyword]" terms-split)))
+ (warn-or-hide
+ (or type (completing-read "Warn (like CW) or hide? "
+ '("warn" "hide") nil :match)))
+ ;; TODO: display "home (and lists)" but just use "home" for API
+ (contexts
+ (or context (completing-read-multiple
+ "Filter contexts [TAB for options, comma separated]: "
+ mastodon-views--filter-types nil :match)))
+ (contexts-processed
+ (if (not contexts)
+ (user-error "You must select at least one context")
+ (mastodon-http--build-array-params-alist "context[]" contexts)))
+ (params (append `(("title" . ,title)
+ ("filter_action" . ,warn-or-hide))
+ terms-processed
+ contexts-processed))
+ (resp (if id
+ (mastodon-http--put url params)
+ (mastodon-http--post url params))))
+ (mastodon-views--filters-triage
+ resp
+ (message "Filter %s %s!" title (if id "updated" "created")))))
+
+(defun mastodon-views-update-filter ()
+ "Update filter at point."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((filter (mastodon-tl--property 'item-json))
+ (id (mastodon-tl--property 'item-id))
+ (name (read-string "Name: " (alist-get 'title filter)))
+ (contexts (completing-read-multiple
+ "Filter contexts [TAB for options, comma separated]: "
+ mastodon-views--filter-types nil :match
+ (mapconcat #'identity
+ (alist-get 'context filter) ",")))
+ (type (completing-read "Warn (like CW) or hide? "
+ '("warn" "hide") nil :match
+ (alist-get 'type filter)))
+ (terms (read-string "Terms to add (comma or space separated): ")))
+ (mastodon-views-create-filter id name contexts type terms))))
+
+(defun mastodon-views-delete-filter ()
+ "Delete filter at point."
+ (interactive)
+ (let* ((id (mastodon-tl--property 'item-id :no-move))
+ (title (mastodon-tl--property 'filter-title :no-move))
+ (url (mastodon-http--api-v2 (format "filters/%s" id))))
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (when (y-or-n-p (format "Delete filter %s? " title))
+ (let ((resp (mastodon-http--delete url)))
+ (mastodon-views--filters-triage
+ resp
+ (message "Filter \"%s\" deleted!" title)))))))
+
+(defun mastodon-views--get-filter-kw (&optional id)
+ "GET filter with ID."
+ (let* ((id (or id (mastodon-tl--property 'kw-id :no-move)))
+ (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
+ (resp (mastodon-http--get-json url)))
+ resp))
+
+(defun mastodon-views-update-filter-kw ()
+ "Update filter keyword.
+Prmopt to change the term, and the whole words option.
+When t, whole words means only match whole words."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((kws (alist-get 'keywords
+ (mastodon-tl--property 'item-json :no-move)))
+ (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
+ (choice (completing-read "Update keyword: " alist))
+ (updated (read-string "Keyword: " choice))
+ (whole-word (if (y-or-n-p "Match whole words only? ")
+ "true"
+ "false"))
+ (params `(("keyword" . ,updated)
+ ("whole_word" . ,whole-word)))
+ (id (cdr (assoc choice alist #'string=)))
+ (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
+ (resp (mastodon-http--put url params)))
+ (mastodon-views--filters-triage resp
+ (format "Keyword %s updated!" updated)))))
+
+(defun mastodon-views--filters-triage (resp msg-str)
+ "Triage filter action response RESP, reload filters, message MSG-STR."
+ (mastodon-http--triage
+ resp
+ (lambda (_resp)
+ (when (mastodon-tl--buffer-type-eq 'filters)
+ (mastodon-views-view-filters))
+ (message msg-str))))
+
+(defun mastodon-views-add-filter-kw ()
+ "Add a keyword to filter at point."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((kw (read-string "Keyword: "))
+ (id (mastodon-tl--property 'item-id :no-move))
+ (whole-word (if (y-or-n-p "Match whole words only? ")
+ "true"
+ "false"))
+ (params `(("keyword" . ,kw)
+ ("whole_word" . ,whole-word)))
+ (url (mastodon-http--api-v2 (format "filters/%s/keywords" id)))
+ (resp (mastodon-http--post url params)))
+ (mastodon-views--filters-triage resp
+ (format "Keyword %s added!" kw)))))
+
+(defun mastodon-views-remove-filter-kw ()
+ "Remove keyword from filter at point."
+ (interactive)
+ (if (not (eq 'filter (mastodon-tl--property 'item-type)))
+ (user-error "No filter at point?")
+ (let* ((kws (alist-get 'keywords
+ (mastodon-tl--property 'item-json :no-move)))
+ (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws))
+ (choice (completing-read "Remove keyword: " alist))
+ (id (cdr (assoc choice alist #'string=)))
+ (url (mastodon-http--api-v2 (format "filters/keywords/%s" id)))
+ (resp (mastodon-http--delete url)))
+ (mastodon-views--filters-triage resp (format "Keyword %s removed!" choice)))))
+
+\f
+;;; FOLLOW SUGGESTIONS
+;; No pagination: max 80 results
+
+(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
+ nil
+ '(("limit" . "80")) ; server max
+ nil
+ "suggested accounts")
+ (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"
+ #'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))
+
+\f
+;;; 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--get-instance-url (url username &optional instance)
+ "Return an instance base url from a user account URL.
+USERNAME is the name to cull.
+If INSTANCE is given, use that."
+ (cond (instance (concat "https://" instance))
+ ;; pleroma URL is https://instance.com/users/username
+ ((string-suffix-p "users/" (url-basepath url))
+ (string-remove-suffix "/users/"
+ (url-basepath url)))
+ ;; friendica is https://instance.com/profile/user
+ ((string-suffix-p "profile/" (url-basepath url))
+ (string-remove-suffix "/profile/"
+ (url-basepath url)))
+ ;; snac is https://instance.com/user
+ ((not (string-match-p "@" url))
+ ;; cull trailing slash:
+ (string-trim-right (url-basepath url) "/"))
+ ;; mastodon is https://instance.com/@user
+ (t
+ (string-remove-suffix (concat "/@" username)
+ url))))
+
+(defun mastodon-views--get-own-instance ()
+ "Return JSON of `mastodon-active-user's instance."
+ (mastodon-http--get-json
+ (mastodon-http--api "instance" "v2") nil nil :vector))
+
+(defun mastodon-views-view-instance-description
+ (&optional user brief instance misskey)
+ "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.
+MISSKEY means the instance is a Misskey or derived server."
+ (interactive)
+ (if user
+ (let ((response (mastodon-views--get-own-instance)))
+ (mastodon-views--instance-response-fun response brief instance))
+ (mastodon-tl--do-if-item
+ (let* ((toot (or (and (mastodon-tl--profile-buffer-p)
+ (mastodon-tl--property 'profile-json)) ; either profile
+ (mastodon-tl--property 'item-json))) ; or toot or user listing
+ (reblog (alist-get 'reblog toot))
+ (account (or (alist-get 'account reblog)
+ (alist-get 'account toot)
+ toot)) ; else `toot' is already an account listing.
+ ;; we may be at toots/boosts/users in a profile buffer.
+ ;; profile-json is a defacto test for if point is on the profile
+ ;; details at the top of a profile buffer.
+ (profile-note-p (and (mastodon-tl--profile-buffer-p)
+ ;; only call this in profile buffers:
+ (mastodon-tl--property 'profile-json)))
+ (url (if profile-note-p
+ (alist-get 'url toot) ; profile description
+ (alist-get 'url account)))
+ (username (if profile-note-p
+ (alist-get 'username toot) ;; profile
+ (alist-get 'username account)))
+ (instance (mastodon-views--get-instance-url url username instance)))
+ (if misskey
+ (let* ((params `(("detail" . ,(or brief t))))
+ (headers '(("Content-Type" . "application/json")))
+ (url (concat instance "/api/meta"))
+ (response
+ (with-current-buffer (mastodon-http--post url params headers t :json)
+ (mastodon-http--process-response))))
+ (mastodon-views--instance-response-fun response brief instance :misskey))
+ (let ((response (mastodon-http--get-json
+ (concat instance "/api/v1/instance") nil nil :vector)))
+ ;; if non-misskey attempt errors, try misskey instance:
+ ;; akkoma i guess should not error here.
+ (if (eq 'error (caar response))
+ (mastodon-views-instance-desc-misskey)
+ (mastodon-views--instance-response-fun response brief instance))))))))
+
+(defun mastodon-views-instance-desc-misskey (&optional user brief instance)
+ "Show instance description for a misskey/firefish server.
+USER, BRIEF, and INSTANCE are all for
+`mastodon-views-view-instance-description', which see."
+ (interactive)
+ (mastodon-views-view-instance-description user brief instance :miskey))
+
+(defun mastodon-views--instance-response-fun (response brief instance
+ &optional misskey)
+ "Display instance description RESPONSE in a new buffer.
+BRIEF means to show fewer details.
+INSTANCE is the instance were are working with.
+MISSKEY means the instance is a Misskey or derived server."
+ (when response
+ (let* ((domain (url-file-nondirectory instance))
+ (buf (get-buffer-create
+ (format "*mastodon-instance-%s*" domain))))
+ (with-mastodon-buffer buf #'special-mode :other-window
+ (if misskey
+ (mastodon-views--insert-json response)
+ (condition-case nil
+ (progn
+ (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-tl--set-buffer-spec (buffer-name buf) "instance" nil)
+ (goto-char (point-min)))
+ (error ; just insert the raw response:
+ (mastodon-views--insert-json response))))))))
+
+(defun mastodon-views--insert-json (response)
+ "Insert raw JSON RESPONSE in current buffer."
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (prin1-to-string response))
+ (pp-buffer)
+ (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+ (apply #'max (mapcar #'length cars)))))
+ (while response
+ (let ((el (pop response)))
+ (cond
+ ((and (vectorp (cdr el)) ; vector of alists (fields, instance rules):
+ (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"))
+ ((and (vectorp (cdr el)) ; vector of strings (media types):
+ (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"))
+ ((consp (cdr el)) ; basic nesting:
+ (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 ((eq (cdr el) :json-false)
+ "no")
+ ((eq (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 to --render-text (for hyperlinks):
+ (mastodon-tl--render-text
+ (if (stringp val) val (prin1-to-string val)))
+ "\n"))))))))
+
+(defun mastodon-views--print-instance-rules-or-fields (alist)
+ "Print ALIST of instance rules or contact account or emoji fields."
+ (let-alist alist
+ (let ((key (or .id .name .shortcode))
+ (value (or .text .value .url)))
+ (indent-to 4)
+ (insert (format "%-5s: "
+ (propertize key 'face '(:underline t)))
+ (mastodon-views--newline-if-long value)
+ (format "%s" (mastodon-tl--render-text
+ value))
+ "\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
--- /dev/null
+;;; mastodon-widget.el --- Widget utilities -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2024 Marty Hiatt
+;; Author: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; 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:
+
+;; some widget utilities for mastodon.el
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar mastodon-widget-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [down-mouse-2] 'widget-button-click)
+ (define-key map [down-mouse-1] 'widget-button-click)
+ (define-key map [touchscreen-begin] 'widget-button-click)
+ ;; The following definition needs to avoid using escape sequences that
+ ;; might get converted to ^M when building loaddefs.el
+ (define-key map [(control ?m)] 'widget-button-press)
+ map)
+ "Keymap containing useful binding for buffers containing widgets.
+Recommended as a parent keymap for modes using widgets.
+Note that such modes will need to require wid-edit.")
+
+(defface mastodon-widget-face
+ '((t :inherit font-lock-function-name-face :weight bold :underline t))
+ "Face for widgets."
+ :group 'mastodon)
+
+(defun mastodon-widget--return-item-widgets (list)
+ "Return a list of item widgets for each item, a string, in LIST."
+ (cl-loop for x in list
+ collect `(choice-item :value ,x :format "%[%v%] "
+ :keymap ,mastodon-widget-keymap)))
+
+(defun mastodon-widget--format (str &optional padding newline)
+ "Return a widget format string for STR, its name.
+PADDING is an integer, for how much right-side padding to add."
+ (concat "%[" (propertize str
+ 'face 'mastodon-widget-face
+ 'mastodon-tab-stop t)
+ "%]: %v"
+ (make-string padding ? )
+ (if newline "\n" "")))
+
+(defun mastodon-widget--create (kind type value notify-fun
+ &optional newline)
+ "Return a widget of KIND, with TYPE elements, and default VALUE.
+KIND is a string, either Listing, Sort, Items, or Inbox, and will
+be used for the widget's tag.
+VALUE is a string, a member of TYPE.
+NOTIFY-FUN is the widget's notify function."
+ (let* ((val-length (length (if (symbolp value)
+ (symbol-name value)
+ value)))
+ (type-list (if (symbolp type)
+ (symbol-value type)
+ type))
+ (longest (apply #'max
+ (mapcar #'length
+ (if (symbolp (car type-list))
+ (mapcar #'symbol-name type-list)
+ type-list))))
+ (padding (- longest val-length)))
+ (if (not (member value type-list))
+ (user-error "%s is not a member of %s" value type-list)
+ (widget-create
+ 'menu-choice
+ :tag kind
+ :value value
+ :args (mastodon-widget--return-item-widgets type-list)
+ :help-echo (format "Select a %s kind" kind)
+ :format (mastodon-widget--format kind padding newline)
+ :notify notify-fun
+ ;; eg format of notify-fun:
+ ;; (lambda (widget &rest ignore)
+ ;; (let ((value (widget-value widget))
+ ;; (tag (widget-get widget :tag)))
+ ;; (notify-fun value)))
+ :keymap mastodon-widget-keymap))))
+
+(provide 'mastodon-widget)
+;;; mastodon-widget.el ends here
--- /dev/null
+;;; mastodon.el --- Client for fediverse services using the Mastodon API -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017-2019 Johnson Denen
+;; Copyright (C) 2020-2022 Marty Hiatt
+;; Copyright (C) 2021 Abhiseck Paira <abhiseckpairaNOSPAMdisroot.org>
+;; Author: Johnson Denen <johnson.denenNOSPAMgmail.com>
+;; Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Maintainer: Marty Hiatt <mousebotNOSPAMdisroot.org>
+;; Package-Version: 20260406.856
+;; Package-Revision: 5bba23045efd
+;; Package-Requires: ((emacs "29.1") (persist "0.8") (tp "0.8"))
+;; 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.el is a client for fediverse services that implement the Mastodon
+;; API. See <https://github.com/mastodon/mastodon>.
+
+;; For set up and usage details, see the Info documentation, or the readme
+;; file at <https://codeberg.org/martianh/mastodon.el>.
+
+;;; Code:
+(require 'cl-lib) ; for `cl-some' call in `mastodon'
+(eval-when-compile (require 'subr-x))
+(require 'url)
+(require 'thingatpt)
+(require 'shr)
+
+(require 'mastodon-http)
+(require 'mastodon-toot)
+(require 'mastodon-search)
+(require 'mastodon-transient)
+(require 'mastodon-tl)
+
+(declare-function discover-add-context-menu "discover")
+(declare-function emojify-mode "emojify")
+
+(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-notifications-policy "mastodon-notifications")
+(autoload 'mastodon-notifications-requests "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-toot-edit-toot-at-point "mastodon-toot")
+(when (require 'lingva nil :no-error)
+ (autoload 'mastodon-toot-translate-toot-text "mastodon-toot"))
+(autoload 'mastodon-toot--view-toot-history "mastodon-tl")
+(autoload 'mastodon-tl-return "mastodon-tl")
+(autoload 'mastodon-tl-jump-to-followed-tag "mastodon-tl")
+(autoload 'mastodon-notifications--update-with-timer "mastodon-notifications")
+(autoload 'mastodon-profile-table-cell-hook-fun "mastodon-profile")
+
+;; for M-x visibility
+;; (views.el uses `mastodon-mode-map', so we can't easily require it)
+(autoload 'mastodon-views-view-follow-suggestions "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-view-filters "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-view-follow-requests "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-view-own-instance "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-view-instance-description "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-view-lists "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-view-scheduled-toots "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-add-account-to-list "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-add-toot-account-at-point-to-list "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-create-list "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-create-filter "mastodon-views"
+ nil :interactive)
+(autoload 'mastodon-views-view-list-timeline "mastodon-views"
+ nil :interactive)
+
+(autoload 'special-mode "simple")
+(autoload 'mastodon-tl--thread-do "mastodon-tl")
+(autoload 'mastodon-notifications--get-unread-count "mastodon-notifications")
+
+(defvar mastodon-tl--highlight-current-toot)
+(defvar mastodon-notifications--map)
+(defvar mastodon-client--token-file)
+
+(defvar alert-default-style)
+(defvar alert-styles)
+
+(defvar mastodon-notifications-grouped-types
+ '("reblog" "favourite") ;; TODO: implement follow!
+ "List of notification types for which grouping is implemented.
+Used in `mastodon-notifications-get'")
+
+(defvar mastodon-notifications-notify-shown nil
+ "Whether recent notifications have been seen by the user or not.")
+
+(defgroup mastodon nil
+ "Interface with Mastodon."
+ :prefix "mastodon-"
+ :group 'external)
+
+(defcustom mastodon-instance-url "https://mastodon.social"
+ "Base URL for the fediverse instance you want to be active.
+For example, if your username is
+\"example_userNOSPAMsocial.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."
+ :type 'string)
+
+(defcustom mastodon-active-user nil
+ "Username of the active user.
+For example, if your username is
+\"example_userNOSPAMsocial.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."
+ :type 'string)
+
+(defcustom mastodon-toot-timestamp-format "%F %T"
+ "Format to use for timestamps.
+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."
+ :type 'string)
+
+(defcustom mastodon-use-emojify nil
+ "Whether to use emojify.el to display emojis.
+From version 28, Emacs can display emojis natively. But
+currently, it doesn't seem to have a way to handle custom emoji,
+while emojify,el has this feature and mastodon.el implements it."
+ :type 'boolean)
+
+;; notifications customizes
+;; moved here because we can load notifs without first loading mastodon.el
+;; or mastodon-notifications.el
+
+(defcustom mastodon-profile-note-in-foll-reqs t
+ "If non-nil, show a user's profile note in follow request notifications."
+ :type '(boolean))
+
+(defcustom mastodon-profile-note-in-foll-reqs-max-length nil
+ "The max character length for user profile note in follow requests.
+Profile notes are only displayed if
+`mastodon-profile-note-in-foll-reqs' is non-nil.
+If unset, profile notes of any size will be displayed, which may
+make them unweildy."
+ :type '(integer))
+
+(defcustom mastodon-images-in-notifs nil
+ "Whether to display attached images in notifications."
+ :type '(boolean))
+
+(defcustom mastodon-group-notifications nil
+ "Whether to use grouped notifications.
+Requires that your instance actually implements grouped notifications.
+Mastodon implemented them in 4.3."
+ :type '(boolean))
+
+(defcustom mastodon-notifications-grouped-names-count 2
+ "The number of notification authors to display.
+A count of 2 for example means to display like so: \"Bob, Jenny
+and X others...\"."
+ :type '(integer))
+
+(defcustom mastodon-notifications-alerts-interval 60
+ "How often to check for new notifications, in seconds."
+ :type '(integer))
+
+(defcustom mastodon-notifications-alerts t
+ "Whether to enable alert.el unread-notification alerts.
+If this is enabled and alert.el is installed, an alert.el notification
+will be shown using `mastodon-notifications-alert-style' as its alert
+style. If this is enabled but alert.el is not installed, alerts will be
+shown using `message'.
+Alerts are only checked for when at least 1 mastodon.el buffer is open."
+ :type '(boolean))
+
+(defcustom mastodon-notifications-alert-style
+ (when (require 'alert nil :noerror) alert-default-style)
+ "The type of alert.el style to use for mastodon.el notification alerts.
+Currently, if you customize this variable, you need to restart Emacs for
+it to take effect, or if you don't have any other alert.el rules set up,
+you can nil `alert-internal-configuration' and reload mastodon.el. This
+only applies to alert.el alerts, if you don't use alert.el, you should
+not set this variable and mastodon.el will message for notification
+alerts."
+ :type
+ `(choice
+ ,@(if (not (require 'alert nil :noerror))
+ '(const nil)
+ (append
+ '((const :tag "alert.el default"
+ :value alert-default-style))
+ (cl-loop for x in alert-styles
+ collect (list 'const :tag (plist-get (cdr x) :title)
+ :value (car x)))))))
+
+(defun mastodon-kill-window ()
+ "Quit window and delete helper."
+ (interactive)
+ (quit-window 'kill))
+
+(defvar mastodon-client--active-user-details-plist)
+(defvar mastodon-auth--token-alist)
+
+;;;###autoload
+(defun mastodon-forget-all-logins ()
+ "Delete `mastodon-client--token-file'.
+Also nil `mastodon-auth--token-alist'."
+ (interactive)
+ (when (y-or-n-p "Remove all saved login data?")
+ (if (not (file-exists-p mastodon-client--token-file))
+ (message "No plstore file")
+ (delete-file mastodon-client--token-file)
+ (message "File %s deleted." mastodon-client--token-file))
+ ;; nil some vars too:
+ (setq mastodon-client--active-user-details-plist nil)
+ (setq mastodon-auth--token-alist nil)))
+
+(defvar mastodon-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; navigation inside a timeline
+ (define-key map (kbd "n") #'mastodon-tl-goto-next-item)
+ (define-key map (kbd "p") #'mastodon-tl-goto-prev-item)
+ (define-key map (kbd "M-n") #'mastodon-tl-next-tab-item)
+ (define-key map (kbd "M-p") #'mastodon-tl-previous-tab-item)
+ (define-key map [?\t] #'mastodon-tl-next-tab-item)
+ (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 "C-#") #'mastodon-tl-list-followed-tags)
+ ;; (define-key map (kbd "\"") #'mastodon-tl-list-followed-tags)
+ (define-key map (kbd "C-\"") #'mastodon-tl-jump-to-followed-tag)
+ (define-key map (kbd "'") #'mastodon-tl-followed-tags-timeline)
+ (define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline)
+ (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 "S-C-n") #'mastodon-notifications-requests)
+ (define-key map (kbd "@") #'mastodon-notifications-get-mentions)
+ (define-key map (kbd "P") #'mastodon-profile-show-user)
+ (define-key map (kbd "s") #'mastodon-search-query)
+ (define-key map (kbd "/") #'mastodon-switch-to-buffer)
+ (define-key map (kbd "\\") #'mastodon-tl-get-remote-local-timeline)
+ ;; quitting mastodon
+ (define-key map (kbd "q") #'kill-current-buffer)
+ (define-key map (kbd "Q") #'mastodon-kill-window)
+ (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)
+ (define-key map (kbd "\"") #'mastodon-toot-quote)
+ (define-key map (kbd "C") #'mastodon-toot-copy-toot-url)
+ (define-key map (kbd "o") #'mastodon-toot-browse-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)
+ (define-key map (kbd "RET") #'mastodon-tl-return)
+ (define-key map (kbd "m") #'mastodon-tl-dm-user)
+ (define-key map (kbd "=") #'mastodon-tl-view-first-full-image)
+ (when (require 'lingva nil :no-error)
+ (define-key map (kbd "a") #'mastodon-toot-translate-toot-text))
+ (define-key map (kbd ",") #'mastodon-toot-list-favouriters)
+ (define-key map (kbd ".") #'mastodon-toot-list-boosters)
+ (define-key map (kbd "C-,") #'mastodon-toot-jump-to-quoting)
+ (define-key map (kbd ";") #'mastodon-views-view-instance-description)
+ (define-key map (kbd "M-;") #'mastodon-tl-nodeinfo-for-toot)
+ ;; override special mode binding
+ (define-key map (kbd "g") #'undefined)
+ (define-key map (kbd "g") #'mastodon-tl-update)
+ ;; 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)
+ (define-key map (kbd "Z") #'mastodon-tl-report-to-mods)
+ ;; own profile
+ (define-key map (kbd "O") #'mastodon-profile-my-profile)
+ (define-key map (kbd "U") #'mastodon-profile-update-user-profile-note)
+ (define-key map (kbd "V") #'mastodon-profile-view-favourites)
+ (define-key map (kbd "K") #'mastodon-profile-view-bookmarks)
+ (define-key map (kbd ":") #'mastodon-user-settings)
+ (define-key map (kbd "C-:") #'mastodon-notifications-policy)
+ ;; 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)
+ (define-key map (kbd "SPC") #'mastodon-tl-scroll-up-command)
+ (define-key map (kbd "!") #'mastodon-tl-fold-post-toggle)
+ (define-key map (kbd "z") #'bury-buffer)
+ map)
+ "Keymap for `mastodon-mode'.")
+
+(defcustom mastodon-mode-hook nil
+ "Hook run when entering Mastodon mode."
+ :type 'hook
+ :options '(provide-discover-context-menu))
+
+(defface mastodon-handle-face
+ '((t :inherit default))
+ "Face used for user handles in bylines.")
+
+(defface mastodon-display-name-face
+ '((t :inherit warning))
+ "Face used for user display names.")
+
+(defface mastodon-boosted-face
+ '((t :inherit success :weight bold))
+ "Face to indicate that a toot is boosted.")
+
+(defface mastodon-boost-fave-face
+ '((t :inherit success))
+ "Face to indicate that you have boosted or favourited a toot.")
+
+(defface mastodon-cw-face
+ '((t :inherit success))
+ "Face used for content warning.")
+
+(defface mastodon-toot-docs-face
+ `((t :inherit shadow))
+ "Face used for documentation in toot compose buffer.
+If `mastodon-tl--enable-proportional-fonts' is changed,
+mastodon.el needs to be re-loaded for this to be correctly set.")
+
+(defface mastodon-toot-docs-reply-text-face
+ `((t :inherit font-lock-comment-face
+ :family ,(face-attribute 'variable-pitch :family)))
+ "Face used for reply text in toot compose buffer.
+See `mastodon-toot-display-orig-in-reply-buffer'.")
+
+(defface mastodon-cursor-highlight-face
+ `((t :inherit highlight :extend t))
+ "Face for `mastodon-tl--highlight-current-toot'.")
+
+;;;###autoload
+(defun mastodon ()
+ "Connect client to `mastodon-instance-url' instance.
+If there are any open mastodon.el buffers, switch to one instead.
+Prority in switching is given to timeline views."
+ (interactive)
+ (let* ((tls (list "home"
+ "local"
+ "federated"
+ (concat (mastodon-auth--user-acct) "-statuses") ; own profile
+ "favourites"
+ "search"))
+ (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
+ (pop-to-buffer buffer '(display-buffer-same-window))
+ ;; we need to update credential-account in case setting have been changed
+ ;; outside mastodon.el in the meantime:
+ (mastodon-return-credential-account :force)
+ (mastodon-tl-get-home-timeline)
+ (message "Loading fediverse account %s on %s..."
+ (mastodon-auth--user-acct)
+ mastodon-instance-url))))
+
+(defvar mastodon-profile-credential-account nil)
+
+;; TODO: the get request in mastodon-http--get-response often returns nil
+;; after waking from sleep, not sure how to fix, or if just my pc.
+;; interestingly it only happens with this function tho.
+(defun mastodon-return-credential-account (&optional force)
+ "Return the CredentialAccount entity.
+Either from `mastodon-profile-credential-account' or from the
+server if that var is nil.
+FORCE means to fetch from the server in any case and update
+`mastodon-profile-credential-account'."
+ (if (or force (not mastodon-profile-credential-account))
+ (setq mastodon-profile-credential-account
+ ;; TODO: we should signal a quit condition after 5 secs here
+ (condition-case nil
+ (mastodon-http--get-json
+ (mastodon-http--api "accounts/verify_credentials")
+ nil :silent)
+ (t ; req fails, return old value
+ mastodon-profile-credential-account)))
+ ;; else just return the var:
+ mastodon-profile-credential-account))
+
+(defvar mastodon-instance-data nil
+ "Instance data from the instance endpoint.")
+
+(defun mastodon-instance-data ()
+ "Return `mastodon-instnace-data' or else fetch from instance endpoint."
+ (or mastodon-instance-data
+ (setq mastodon-instance-data
+ (mastodon-http--get-json (mastodon-http--api "instance")))))
+
+(defun mastodon-instance-version ()
+ "Return the version string of user's instance."
+ (alist-get 'version (mastodon-instance-data)))
+
+;;;###autoload
+(defun mastodon-toot (&optional user reply-to-id reply-json
+ quote-id quote-json visibility)
+ "Update instance with new toot. Content is captured in a new buffer.
+If USER is non-nil, insert after @ symbol to begin new toot.
+If REPLY-TO-ID is non-nil, attach new toot to a conversation.
+If REPLY-JSON is the json of the toot being replied to.
+QUOTE-ID is the id of a toot being quoted, QUOTE-JSON is its data.
+VISIBILITY is the visibility of the toot."
+ (interactive)
+ (mastodon-toot--compose-buffer user reply-to-id reply-json
+ nil nil quote-id quote-json visibility))
+
+;;;###autoload
+(defun mastodon-notifications-get (&optional type buffer-name max-id)
+ "Display NOTIFICATIONS in buffer.
+Optionally only print notifications of type TYPE, a string.
+BUFFER-NAME is added to \"*mastodon-\" to create the buffer name.
+MAX-ID is a request parameter for pagination."
+ (interactive)
+ (let* ((buffer-name (or buffer-name "notifications"))
+ (buffer (concat "*mastodon-" buffer-name "*")))
+ (message "Loading your notifications...")
+ (mastodon-tl--init-sync
+ buffer-name
+ "notifications"
+ 'mastodon-notifications--timeline
+ type
+ `(,@(when mastodon-group-notifications
+ (mastodon-http--build-array-params-alist
+ "grouped_types[]" mastodon-notifications-grouped-types))
+ ,@(when max-id
+ `(("max_id" . ,(mastodon-tl--buffer-property 'max-id)))))
+ nil nil nil
+ (if (or (not mastodon-group-notifications)
+ ;; if version less than 1st grouped notifs release:
+ (> 4.3 (string-to-number
+ (mastodon-instance-version))))
+ "v1"
+ "v2"))
+ (with-current-buffer (get-buffer-create buffer)
+ (use-local-map mastodon-notifications--map)
+ (when mastodon-notifications-notify-shown
+ (setq mastodon-notifications-notify-shown nil)))
+ (message "Loading your notifications... Done")))
+
+;;;###autoload
+(defun mastodon-notifications-check ()
+ "Check for the number of unread notifications."
+ (interactive)
+ (let ((count (mastodon-notifications--get-unread-count)))
+ (message "Unread notifications: %s" count)))
+
+;; URL lookup: should be available even if `mastodon.el' not loaded:
+
+;;;###autoload
+(defun mastodon-url-lookup (&optional query-url force)
+ "If a URL resembles a fediverse link, try to load in `mastodon.el'.
+Does a WebFinger lookup on the server.
+URL can be arg QUERY-URL, or URL at point, or provided by the user.
+If a status or account is found, load it in `mastodon.el', if
+not, just browse the URL in the normal fashion.
+If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'."
+ (interactive)
+ (let* ((query (or query-url
+ (mastodon-tl--property 'shr-url :no-move)
+ (thing-at-point-url-at-point)
+ (read-string "Lookup URL: "))))
+ (if (and (not force)
+ (not (mastodon--fedi-url-p query)))
+ ;; (shr-browse-url query) ; doesn't work (keep our shr keymap)
+ (progn (message "Using external browser")
+ (browse-url query))
+ (message "Performing lookup...")
+ (let* ((url (format "%s/api/v2/search" mastodon-instance-url))
+ (params `(("q" . ,query)
+ ("resolve" . "t"))) ; webfinger
+ (response (mastodon-http--get-json url params :silent)))
+ (cond ((not (seq-empty-p (alist-get 'statuses response)))
+ (let* ((statuses (assoc 'statuses response))
+ (status (seq-first (cdr statuses)))
+ (status-id (alist-get 'id status)))
+ (mastodon-tl--thread-do status-id)))
+ ((not (seq-empty-p (alist-get 'accounts response)))
+ (let* ((accounts (assoc 'accounts response))
+ (account (seq-first (cdr accounts))))
+ (mastodon-profile--make-author-buffer account)))
+ (t
+ (message "Lookup failed. Using external browser")
+ (browse-url query)))))))
+
+(defun mastodon-url-lookup-force ()
+ "Call `mastodon-url-lookup' without checking if URL is fedi-like."
+ (interactive)
+ (mastodon-url-lookup nil :force))
+
+(defun mastodon--fedi-url-p (url)
+ "Check if QUERY resembles a fediverse URL."
+ ;; calqued off https://github.com/tuskyapp/Tusky/blob/c8fc2418b8f5458a817bba221d025b822225e130/app/src/main/java/com/keylesspalace/tusky/BottomSheetActivity.kt
+ ;; thx to Conny Duck!
+ ;; mastodon at least seems to allow only [a-z0-9_] for usernames, plus "."
+ ;; but not at beginning or end, see https://github.com/mastodon/mastodon/issues/6830
+ ;; objects may have - in them
+ (let* ((uri-parsed (url-generic-parse-url url))
+ (query (url-filename uri-parsed)))
+ (save-match-data
+ (or (string-match "^/@[^/]+$" query)
+ (string-match "^/@[^/]+/[[:digit:]]+$" query)
+ (string-match "^/user[s]?/@?[[:alnum:]_]+$" query) ; @: pleroma or soapbox
+ (string-match "^/notice/[[:alnum:]]+$" query)
+ (string-match "^/objects/[-a-f0-9]+$" query)
+ (string-match "^/notes/[a-z0-9]+$" query)
+ (string-match "^/display/[-a-f0-9]+$" query)
+ (string-match "^/profile/[[:alpha:]_]+$" query)
+ (string-match "^/p/[[:alpha:]_]+/[[:digit:]]+$" query)
+ (string-match "^/[[:alpha:]_]+$" query)
+ (string-match "^/u/[[:alpha:]_]+$" query)
+ (string-match "^/c/[[:alnum:]_]+$" query)
+ (string-match "^/post/[[:digit:]]+$" query)
+ (string-match "^/comment/[[:digit:]]+$" query) ; lemmy
+ (string-match "^/@[^/]+/statuses/[[:alnum:]]" query) ; GTS
+ (string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" query) ; hometown
+ (string-match "^/notes/[[:alnum:]]+$" query) ; misskey post
+ (string-match "^/w/[[:alnum:]_]+$" query) ; peertube post
+ ;; bsky via fed.brid.gy (unsure if this needs narrowing down?):
+ (string-prefix-p "https://fed.brid.gy/r/" url)))))
+
+(defun mastodon-live-buffers ()
+ "Return a list of open mastodon buffers.
+Calls `mastodon-tl--get-buffer-type', which see."
+ (cl-loop for x in (buffer-list)
+ when (with-current-buffer x (mastodon-tl--get-buffer-type))
+ collect (get-buffer x)))
+
+(defun mastodon-buffer-p (&optional buffer)
+ "Non-nil if BUFFER or `current-buffer' is a mastodon one."
+ (let ((buf (or buffer (current-buffer))))
+ (member buf (mastodon-live-buffers))))
+
+(defun mastodon-kill-all-buffers ()
+ "Kill any and all open mastodon buffers, hopefully."
+ (interactive)
+ (let ((mastodon-buffers (mastodon-live-buffers)))
+ (cl-loop for x in mastodon-buffers
+ do (kill-buffer x))))
+
+(defun mastodon-switch-to-buffer ()
+ "Switch to a live mastodon buffer."
+ (interactive)
+ (let ((choice (completing-read
+ "Switch to mastodon buffer: "
+ (mapcar #'buffer-name (mastodon-live-buffers))
+ nil :match)))
+ (switch-to-buffer choice)))
+
+(defun mastodon--url-at-point ()
+ "`thing-at-point' provider function."
+ (get-text-property (point) 'shr-url))
+
+(defun mastodon-mode-hook-fun ()
+ "Function to add to `mastodon-mode-hook'."
+ (when (and mastodon-use-emojify
+ (require 'emojify nil :noerror))
+ (emojify-mode t)
+ (when mastodon-toot--enable-custom-instance-emoji
+ (mastodon-toot-enable-custom-emoji)))
+ (mastodon-profile--fetch-server-account-settings)
+ (when (and mastodon-tl--highlight-current-toot
+ (fboundp #'cursor-face-highlight-mode))
+ (cursor-face-highlight-mode)) ; 29.1
+ ;; make `thing-at-point' functions work:
+ (setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ '((url . mastodon--url-at-point))))
+ ;; notifs timer
+ (when mastodon-notifications-alerts
+ (mastodon-notifications--update-with-timer))
+ ;; pretty table override bindings:
+ (add-hook 'table-cell-map-hook
+ #'mastodon-profile-table-cell-hook-fun
+ nil :local))
+
+;;;###autoload
+(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun)
+
+(define-derived-mode mastodon-mode special-mode "Mastodon"
+ "Major mode for fediverse services using the Mastodon API."
+ (read-only-mode 1))
+
+(provide 'mastodon)
+;;; mastodon.el ends here
--- /dev/null
+This is mastodon.info, produced by makeinfo version 6.8 from
+mastodon.texi.
+
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Mastodon: (mastodon). Client for fediverse services using the Mastodon API.
+END-INFO-DIR-ENTRY
+
+\1f
+File: mastodon.info, Node: Top, Next: README, Up: (dir)
+
+A Mastodon client
+*****************
+
+* Menu:
+
+* README::
+
+— The Detailed Node Listing —
+
+README
+
+* Installation::
+* Usage::
+* Dependencies::
+* Network compatibility::
+* Contributing::
+* Supporting ‘mastodon.el’: Supporting mastodonel.
+* Contributors::
+* Screenshots::
+
+Installation
+
+* ELPA::
+* MELPA::
+* Repo::
+* Emoji::
+* Discover::
+
+Usage
+
+* Logging in to your instance::
+* Timelines::
+* Composing toots::
+* Other commands and account settings::
+* Notifications::
+* Customization::
+* Commands and variables index::
+* Packages related to ‘mastodon.el’: Packages related to mastodonel.
+* Live-updating timelines mastodon-async-mode::
+* Translating toots::
+* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel.
+
+Contributing
+
+* Bug reports::
+* Fixes and features::
+* Coding style::
+
+
+\1f
+File: mastodon.info, Node: README, Prev: Top, Up: Top
+
+1 README
+********
+
+‘mastodon.el’ is an Emacs client for the ActivityPub social networks
+that implement the Mastodon API. For info see joinmastodon.org
+(https://joinmastodon.org/).
+
+ NB: ‘mastodon.el’ now ships this readme as an .info file, so if you
+have it installed you should be able to browse this readme inside emacs.
+‘C-h i’ for info, then ‘m masto RET’ should load it for you.
+
+* Menu:
+
+* Installation::
+* Usage::
+* Dependencies::
+* Network compatibility::
+* Contributing::
+* Supporting ‘mastodon.el’: Supporting mastodonel.
+* Contributors::
+* Screenshots::
+
+\1f
+File: mastodon.info, Node: Installation, Next: Usage, Up: README
+
+1.1 Installation
+================
+
+You can install ‘mastodon.el’ from ELPA, MELPA, or directly from this
+repo. It is also available as a GUIX package.
+
+* Menu:
+
+* ELPA::
+* MELPA::
+* Repo::
+* Emoji::
+* Discover::
+
+\1f
+File: mastodon.info, Node: ELPA, Next: MELPA, Up: Installation
+
+1.1.1 ELPA
+----------
+
+You should be able to directly install with:
+
+ ‘M-x package-refresh-contents RET’
+
+ ‘M-x package-install RET mastodon RET’
+
+\1f
+File: mastodon.info, Node: MELPA, Next: Repo, Prev: ELPA, Up: Installation
+
+1.1.2 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’
+
+\1f
+File: mastodon.info, Node: Repo, Next: Emoji, Prev: MELPA, Up: Installation
+
+1.1.3 Repo
+----------
+
+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 28.1. But if you are running an
+older version it shouldn’t be very hard to get it working.
+
+\1f
+File: mastodon.info, Node: Emoji, Next: Discover, Prev: Repo, Up: Installation
+
+1.1.4 Emoji
+-----------
+
+Since Emacs 28, it has builtin emoji support with ‘emoji.el’. If you
+prefer to use Emojify (https://github.com/iqbalansari/emacs-emojify),
+‘require’ it and set ‘mastodon-use-emojify’ to non-nil to display emoji
+in timelines and to use it when composing toots. ‘Emoji.el’ is the
+better option, but for now only ‘emojify’ supports downloading and using
+custom emoji from your instance. From personal experience, ‘emojify’
+also tends to result in less TOFU.
+
+\1f
+File: mastodon.info, Node: Discover, Prev: Emoji, Up: Installation
+
+1.1.5 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))
+
+\1f
+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::
+* Notifications::
+* Customization::
+* Commands and variables index::
+* Packages related to ‘mastodon.el’: Packages related to mastodonel.
+* Live-updating timelines mastodon-async-mode::
+* Translating toots::
+* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel.
+
+\1f
+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, call ‘(mastodon-forget-all-logins)’, restart
+Emacs and follow the steps again.
+
+ 1. encrypted access tokens (from 2.0.0)
+
+ By default, user access tokens are now stored in the user’s auth
+ source file (typically ‘~/.authinfo.gpg’, check the value of
+ ‘auth-sources’). When you first update to 2.0.0, or if you
+ encounter issues due to old credentials, call
+ ‘(mastodon-forget-all-logins)’ to remove the old mastodon.el
+ plstore, and then authenticate again. If you don’t want to use the
+ auth source file, set ‘mastodon-auth-use-auth-source’ to nil.
+ Entries will instead be stored encrypted in
+ ‘mastodon-client--token-file’, a plstore.
+
+ If for some reason you reauthenticate, you’ll need to either remove
+ the entry in your auth sources file, or manually update the token
+ in it after doing so, as mastodon.el is unable to reliably update
+ (or even remove) entries.
+
+ The format for a mastodon.el auth source entry is as follows:
+
+ ‘machine INSTANCE login USERNAME password AUTHTOKEN’
+
+ with the token being what you copy from the browser when
+ authenticating. If you have ‘auth-source-save-behavior’ set to
+ nil, you’ll also need to add such an entry manually.
+
+ Finally, if you find you’re asked for your key passphrase too often
+ while authenticating, consider setting ‘epa-file-encrypt-to’ (for
+ auth-source encryption) and ‘plstore-encrypt-to’ (for plstore
+ encryption) to your preferred key ID.
+
+\1f
+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
+
+ For a full list of commands and variables, see mastodon-index.org
+ (mastodon-index.org).
+
+ Key Action
+ -----------------------------------------------------------------------------------------------------------
+ *Help*
+ ‘?’ Show discover menu of all bindings, if ‘discover’ is available
+ *Timeline actions*
+ ‘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 (1 prefix arg: hide-replies, 2 prefix args: media only)
+ ‘H’ Open home timeline (1 prefix arg: hide-replies)
+ ‘L’ Open local timeline (1 prefix arg: hide-replies, 2 prefix args: media only)
+ ‘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 followed tags and load a tag timeline
+ ‘C-:’ view timeline of all followed tags
+ ‘,’ view favouriters of toot at point
+ ‘.’ view boosters of toot at point
+ ‘/’ switch between mastodon buffers
+ ‘\’ prompt for an instance domain and view its local timeline (if poss)
+ ‘Z’ report user/toot at point to instances moderators
+ *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
+ ‘S-:’ view profile/account settings transient menu
+ *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
+ ‘!’ toggle folding of toot at point
+ (‘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, statuses without boosts, followers, and following
+ ‘mastodon-profile--add-account-to-list’ (see lists view)
+ *Notifications view*
+ ‘a’, ‘j’ accept/reject follow request
+ ‘C-k’ clear notification at point
+ ‘C-c C-c’ cycle between notification types
+ 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
+ --------------------------------------------
+ ‘(🔁)’ (or I boosted this toot
+ ‘(B)’)
+ ‘(⭐)’ (or I favourited this toot
+ ‘(F)’)
+ ‘(🔖)’ (or I bookmarked this toot
+ ‘(K)’)
+
+\1f
+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) opens 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. Further keybindings
+are displayed in the buffer, and in the following subsection.
+
+ Replies preserve visibility status/content warnings, and include
+boosters by default. If the region is active when you start a reply, it
+will be yanked into the compose buffer prefixed with ‘>’ to form a rough
+reply quote.
+
+ Server’s max toot length, with running char count, 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’).
+
+ If you want to view some of the toot being replied to in the compose
+buffer, set ‘mastodon-toot-display-orig-in-reply-buffer’ to non-nil.
+
+ 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’ Insert emoji
+ ‘C-c C-p’ Create a poll
+ ‘C-c C-o’ Cancel poll
+ ‘C-c C-l’ Set toot language
+ ‘C-c C-s’ Schedule toot
+
+ 2. Autocompletion of mentions, tags and emoji
+
+ Autocompletion of mentions, tags, and emojis is provided by
+ ‘completion-at-point-functions’ (capf) backends.
+ ‘mastodon-toot--enable-completion’ is enabled by default.
+
+ To trigger completion, type a prefix followed by a few letters, ‘@’
+ for mentions, ‘#’ for tags, and ‘:’ for emoji (for now this only
+ works when using ‘emojify.el’).
+
+ 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.)
+
+ If you don’t run ‘company’ and want immediate, keyless completion,
+ you’ll need to have another completion engine running that handles
+ capfs. A common combination is ‘consult’ and ‘corfu’.
+
+ 3. 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.
+
+\1f
+File: mastodon.info, Node: Other commands and account settings, Next: Notifications, 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 a ‘mastodon.el’ buffer:
+ • ‘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-search--trending-statuses’: View a list of trending
+ statuses on your instance.
+ • ‘mastodon-search--trending-links’: View a list of trending links on
+ your instance (+ click through to a timeline of posts featuring a
+ given link)
+
+ • ‘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-tl--followed-tags-timeline’: View a timeline of all your
+ followed tags.
+ • ‘mastodon-tl--some-followed-tags-timleine’: View a timeline of
+ multiple tags, from your followed tags or any other.
+
+ • ‘mastodon-switch-to-buffer’: switch between mastodon buffers.
+
+ • ‘mastodon-tl--get-remote-local-timeline’: View a local timeline of
+ a remote instance.
+ • ‘mastodon-tl--remote-tag-timeline’: View a tag timeline on a remote
+ instance.
+
+ • ‘mastodon-user-settings’: Launch a transient menu to update various
+ account settings.
+
+\1f
+File: mastodon.info, Node: Notifications, Next: Customization, Prev: Other commands and account settings, Up: Usage
+
+1.2.5 Notifications
+-------------------
+
+Mastodon from 4.3 supports grouped notifications. These are implemented
+by ‘mastodon.el’ but disabled by default out of consideration to users
+on instances that don’t support them. If you are on an instance that
+implements grouped notifications, set ‘mastodon-group-notifications’ to
+‘t’ to enable them.
+
+\1f
+File: mastodon.info, Node: Customization, Next: Commands and variables index, Prev: Notifications, Up: Usage
+
+1.2.6 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
+
+ • Nofitication options:
+ • Display user’s profile note in follow requests
+ • Group notifications
+
+\1f
+File: mastodon.info, Node: Commands and variables index, Next: Packages related to mastodonel, Prev: Customization, Up: Usage
+
+1.2.7 Commands and variables index
+----------------------------------
+
+An index of all user-facing commands and custom variables is available
+here: mastodon-index.org (mastodon-index.org).
+
+ You can also hit ‘?’ in any ‘mastodon.el’ buffer to see the available
+bindings, or run ‘M-X’ (upper-case ‘X’) to view all commands in the
+buffer with completion, and call one.
+
+\1f
+File: mastodon.info, Node: Packages related to mastodonel, Next: Live-updating timelines mastodon-async-mode, Prev: Commands and variables index, Up: Usage
+
+1.2.8 Packages related to ‘mastodon.el’
+---------------------------------------
+
+ 1. Alternative timeline layout
+
+ The incomparable Nicholas Rougier has written an alternative
+ timeline layout for ‘mastodon.el’.
+
+ The repo is at mastodon-alt
+ (https://github.com/rougier/mastodon-alt).
+
+ 2. Org links, archive search
+
+ toot-suite (https://codeberg.org/chrmoe/toot-suite) implements an
+ org link type for fediverse posts, and also provides a way to
+ browse an offline archive of your account.
+
+ 3. Mastodon hydra
+
+ A user made a hydra for handling basic ‘mastodon.el’ commands.
+ It’s available at
+ <https://holgerschurig.github.io/en/emacs-mastodon-hydra/>.
+
+ 4. Narrow to timeline item
+
+ A simple code snippet to enable narrowing to current item in
+ timelines:
+ <http://takeonrules.com/2024/10/31/hacking-on-mastodon-emacs-package-to-narrow-viewing/>
+
+ 5. Sachac’s config goodies
+
+ The incomparable sachac has a bunch of ‘mastodon.el’ extensions and
+ goodies in their literate config, available here:
+ <https://sachachua.com/dotemacs/index.html#mastodon>.
+
+\1f
+File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Packages related to mastodonel, Up: Usage
+
+1.2.9 Live-updating timelines: ‘mastodon-async-mode’
+----------------------------------------------------
+
+(code taken from mastodon-future
+(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-’.
+
+\1f
+File: mastodon.info, Node: Translating toots, Next: Bookmarks and mastodonel, Prev: Live-updating timelines mastodon-async-mode, Up: Usage
+
+1.2.10 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
+lingva.ml (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 'item-json)))
+ (if toot
+ (lingva-translate nil (mastodon-tl--content toot))
+ (message "No toot to translate?"))))
+
+\1f
+File: mastodon.info, Node: Bookmarks and mastodonel, Prev: Translating toots, Up: Usage
+
+1.2.11 Bookmarks and ‘mastodon.el’
+----------------------------------
+
+‘mastodon.el’ implements a basic bookmark record and handler.
+Currently, this means that you can bookmark a post item and later load
+it in thread view. This could be expanded to any item with an id, but
+probably not to things like timeline views. If you want to be able to
+bookmark something, open an issue and ask, as it’s trivial to expand the
+bookmarking code.
+
+\1f
+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, emacs-request
+ (https://github.com/tkf/emacs-request))
+ • ‘persist’ (for storing some settings across sessions, persist
+ (https://elpa.gnu.org/packages/persist.html))
+ • ‘tp.el’ (for transient menus, tp.el
+ (https://codeberg.org/martianh/tp.el))
+
+ Optional dependencies (install yourself, ‘mastodon.el’ can use them):
+ • ‘emojify’ to use custom emoji (else we use builtin ‘emoji.el’)
+ • ‘mpv’ and ‘mpv.el’ for viewing videos and gifs
+ • ‘lingva.el’ for translating toots
+
+\1f
+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 (pleroma.social (https://pleroma.social/))
+ • Akkoma (akkoma.social (https://akkoma.social/))
+ • Gotosocial (gotosocial.org (https://gotosocial.org/))
+ • Sharkey (joinsharkey.org (https://joinsharkey.org))
+
+ It does not support the non-Mastodon API servers Misskey (misskey.io
+(https://misskey.io/)), Firefish (joinfirefish.org
+(https://joinfirefish.org/), formerly Calkey) and Friendica, but it
+should fully support displaying and interacting with posts and users on
+those platforms.
+
+ If you attempt to use ‘mastodon.el’ with a server and run into
+problems, feel free to open an issue.
+
+\1f
+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!
+
+ If you prefer emailing patches to the process described below, feel
+free to send them on. Ideally they’d be patches that can be applied
+with ‘git am’, if you want to actually contribute a commit.
+
+* Menu:
+
+* Bug reports::
+* Fixes and features::
+* Coding style::
+
+\1f
+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. Else 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.
+
+\1f
+File: mastodon.info, Node: Fixes and features, Next: Coding style, Prev: Bug reports, Up: Contributing
+
+1.5.2 Fixes and features
+------------------------
+
+ 1. Install Cask
+ (https://cask.readthedocs.io/en/latest/guide/installation.html) if
+ you don’t already have it installed
+ 2. Create an issue (https://codeberg.org/martianh/mastodon.el/issues)
+ detailing what you’d like to do.
+ 3. Fork the repository and create a branch off of ‘develop’.
+ 4. Run the tests (with ‘make tests’) and ensure that your code doesn’t
+ break any of them.
+ 5. Create a pull request (to develop) referencing the issue created in
+ step 2.
+
+\1f
+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).
+
+\1f
+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).
+
+ I also accept support via liberapay:
+
+ If you would prefer a different payment method, please write to me at
+<mousebot {at} disroot.org> and I can provide IBAN or other bank account
+details.
+
+ I don’t have a tech worker’s income, so even a small tip would help
+out.
+
+\1f
+File: mastodon.info, Node: Contributors, Next: Screenshots, 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>
+
+\1f
+File: mastodon.info, Node: Screenshots, Prev: Contributors, Up: README
+
+1.8 Screenshots
+===============
+
+Here’s a (federated) timeline:
+
+\0\b[image src="screenshot-tl.png"\0\b]
+
+
+ Here’s a notifcations view plus a compose buffer:
+
+\0\b[image src="screenshot-notifs+compose.png"\0\b]
+
+
+ Here’s a user settings transient (active values green, current server
+values commented and, if a boolean, underlined):
+
+\0\b[image src="screenshot-transient-1.jpg"\0\b]
+
+
+ Here’s a user profile fields transient (changed fields green, current
+server values commented):
+
+\0\b[image src="screenshot-transient-2.jpg"\0\b]
+
+
+
+\1f
+Tag Table:
+Node: Top\7f219
+Node: README\7f1083
+Node: Installation\7f1732
+Node: ELPA\7f2021
+Node: MELPA\7f2249
+Node: Repo\7f2629
+Node: Emoji\7f3122
+Node: Discover\7f3716
+Node: Usage\7f4268
+Node: Logging in to your instance\7f4770
+Ref: encrypted access tokens (from 200)\7f5742
+Node: Timelines\7f7200
+Ref: Keybindings\7f7675
+Ref: Toot byline legend\7f12657
+Node: Composing toots\7f12966
+Ref: Keybindings (1)\7f14518
+Ref: Autocompletion of mentions tags and emoji\7f15073
+Ref: Draft toots\7f15998
+Node: Other commands and account settings\7f16469
+Node: Notifications\7f19144
+Node: Customization\7f19629
+Node: Commands and variables index\7f20517
+Node: Packages related to mastodonel\7f21036
+Ref: Alternative timeline layout\7f21289
+Ref: Org links archive search\7f21516
+Ref: Mastodon hydra\7f21735
+Ref: Narrow to timeline item\7f21919
+Ref: Sachac's config goodies\7f22126
+Node: Live-updating timelines mastodon-async-mode\7f22345
+Node: Translating toots\7f23200
+Node: Bookmarks and mastodonel\7f24383
+Node: Dependencies\7f24925
+Node: Network compatibility\7f25711
+Node: Contributing\7f26652
+Node: Bug reports\7f27148
+Node: Fixes and features\7f28059
+Node: Coding style\7f28722
+Node: Supporting mastodonel\7f29346
+Node: Contributors\7f29947
+Node: Screenshots\7f30382
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
projects / emacsconfig.git / commitdiff