--- /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>
+;; 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)
+(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")
+
+(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)
+
+(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 **
+
+It appears that you are not aware of the recent developments in
+mastodon.el. In short we now require that you also set the
+variable `mastodon-active-user' in your init file in addition to
+`mastodon-instance-url'.
+
+Please see its documentation to understand what value it accepts
+by running M-x describe-variable on it or visiting our web page:
+https://codeberg.org/martianh/mastodon.el
+
+We apologize for the inconvenience.
+")
+
+(defun mastodon-auth--get-browser-login-url ()
+ "Return properly formed browser login url."
+ (mastodon-http--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" . ,(plist-get (mastodon-client) :client_id)))))
+
+(defvar mastodon-auth--explanation
+ (format
+ "
+1. A URL has been copied to your clipboard. Open this URL in a
+javascript capable browser and your browser will take you to your
+Mastodon instance's login page.
+
+2. Login to your account (%s) and authorize \"mastodon.el\".
+
+3. After authorization you will be presented an authorization
+code. Copy this code and paste it in the minibuffer prompt."
+ (mastodon-client--form-user-from-vars)))
+
+(defun mastodon-auth--show-notice (notice buffer-name &optional ask)
+ "Display NOTICE to user.
+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--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=))
+ ((plist-get (mastodon-client--active-user) :access_token)
+ ;; user variables need to be read from plstore.
+ (push (cons mastodon-instance-url
+ (plist-get (mastodon-client--active-user) :access_token))
+ mastodon-auth--token-alist)
+ (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil #'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*")
+ (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--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 "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-notifications-"))
+
+\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-tl-" "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-transient-"))
+
+\f
+;;; Generated autoloads from mastodon-views.el
+
+(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>
+;; 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)
+
+(autoload 'mastodon-http--api "mastodon-http")
+(autoload 'mastodon-http--post "mastodon-http")
+
+(defcustom mastodon-client--token-file (concat user-emacs-directory "mastodon.plstore")
+ "File path where Mastodon access tokens are stored."
+ :group 'mastodon
+ :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."
+ (with-current-buffer (mastodon-client--register)
+ (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-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."
+ (let ((plstore (plstore-open (mastodon-client--token-file)))
+ (client (mastodon-client--fetch))
+ ;; 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) client nil)
+ (plstore-save plstore)
+ (plstore-close plstore)
+ client))
+
+(defun mastodon-client--remove-key-from-plstore (plstore)
+ "Remove KEY from PLSTORE."
+ (cdr plstore))
+
+;; Actually it returns a plist with client-details if such details are
+;; already stored in mastodon.plstore
+(defun mastodon-client--read ()
+ "Retrieve client_id and client_secret from `mastodon-client--token-file'."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (mastodon (plstore-get plstore (concat "mastodon-" mastodon-instance-url))))
+ (mastodon-client--remove-key-from-plstore mastodon)))
+
+(defun mastodon-client--general-read (key)
+ "Retrieve the plstore item keyed by KEY.
+Return plist without the KEY."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (plstore-item (plstore-get plstore key)))
+ (mastodon-client--remove-key-from-plstore plstore-item)))
+
+(defun mastodon-client--make-user-details-plist ()
+ "Make a plist with current user details. Return it."
+ `(:username ,(mastodon-client--form-user-from-vars)
+ :instance ,mastodon-instance-url
+ :client_id ,(plist-get (mastodon-client) :client_id)
+ :client_secret ,(plist-get (mastodon-client) :client_secret)))
+
+(defun mastodon-client--store-access-token (token)
+ "Save TOKEN as :access_token in plstore of the current user.
+Return the plist after the operation."
+ (let* ((user-details (mastodon-client--make-user-details-plist))
+ (plstore (plstore-open (mastodon-client--token-file)))
+ (username (plist-get user-details :username))
+ (plstore-value (setq user-details
+ (plist-put user-details :access_token token)))
+ (print-length nil)
+ (print-level nil))
+ (plstore-put plstore (concat "user-" username) plstore-value nil)
+ (plstore-save plstore)
+ (plstore-close plstore)
+ plstore-value))
+
+(defun mastodon-client--make-user-active (user-details)
+ "USER-DETAILS is a plist consisting of user details."
+ (let ((plstore (plstore-open (mastodon-client--token-file)))
+ (print-length nil)
+ (print-level nil))
+ (plstore-put plstore "active-user" user-details nil)
+ (plstore-save plstore)
+ (plstore-close plstore)))
+
+(defun mastodon-client--form-user-from-vars ()
+ "Create a username from user variable. Return that username.
+Username in the form 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)
+ (when (setq user-plist
+ (mastodon-client--general-read (concat "user-" username)))
+ (mastodon-client--make-user-active user-plist))
+ user-plist))
+
+(defun mastodon-client--current-user-active-p ()
+ "Return user-details if the current user is active.
+Otherwise return nil."
+ (let ((username (mastodon-client--form-user-from-vars))
+ (user-details (mastodon-client--general-read "active-user")))
+ (when (and user-details
+ (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."
+ (let ((active-user-details mastodon-client--active-user-details-plist))
+ (unless active-user-details
+ (setq active-user-details
+ (or (mastodon-client--current-user-active-p)
+ (mastodon-client--make-current-user-active)))
+ (setq mastodon-client--active-user-details-plist
+ active-user-details))
+ active-user-details))
+
+(defun mastodon-client ()
+ "Return variable client secrets to use for `mastodon-instance-url'.
+Read plist from `mastodon-client--token-file' if variable is nil.
+Fetch and store plist if `mastodon-client--read' returns nil."
+ (let ((client-details
+ (cdr (assoc mastodon-instance-url mastodon-client--client-details-alist))))
+ (unless client-details
+ (setq 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--open-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 'request) ; for attachments upload
+(require 'url)
+(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")
+
+(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--response ()
+ "Capture response buffer content as string."
+ (with-current-buffer (current-buffer)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun mastodon-http--response-body (pattern)
+ "Return substring matching PATTERN from `mastodon-http--response'."
+ (let ((resp (mastodon-http--response)))
+ (string-match pattern resp)
+ (match-string 0 resp)))
+
+(defun mastodon-http--status ()
+ "Return HTTP Response Status Code from `mastodon-http--response'."
+ (let* ((status-line (mastodon-http--response-body "^HTTP/1.*$")))
+ (string-match "[0-9][0-9][0-9]" status-line)
+ (match-string 0 status-line)))
+
+(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--triage (response success)
+ "Determine if RESPONSE was successful.
+Call SUCCESS if successful. Message status and JSON error from
+RESPONSE if unsuccessful."
+ (let ((status (with-current-buffer response
+ (mastodon-http--status))))
+ (if (string-prefix-p "2" status)
+ (funcall success response)
+ (if (string-prefix-p "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 (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 (unless json
+ (mastodon-http--concat-params-to-url url params)))
+ (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 (;(request-timeout 5) ; this is from request.el no url.el!
+ (url-request-data (when params
+ (mastodon-http--build-params-string params))))
+ (with-temp-buffer
+ (url-retrieve url callback cbargs)))))
+
+;; TODO: test for curl first?
+(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."
+ (let* ((file (file-name-nondirectory filename))
+ (request-backend 'curl)
+ (desc `(("description" . ,caption)))
+ (cb (cl-function
+ (lambda (&key data &allow-other-keys)
+ (when data
+ (let* ((id (alist-get 'id data)))
+ ;; update ids:
+ (push id 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 desc)))
+ (message "Uploading %s... (done)" file)
+ (mastodon-toot--update-status-fields)))))))
+ (request
+ url
+ :type "POST"
+ :params desc
+ :files `(("file" . (,file :file ,filename
+ :mime-type "multipart/form-data")))
+ :parser 'json-read
+ :headers `(("Authorization" . ,(concat "Bearer "
+ (mastodon-auth--access-token))))
+ :sync nil
+ :success (apply-partially cb)
+ :error (cl-function
+ (lambda (&key error-thrown &allow-other-keys)
+ (cond
+ ;; handle curl errors first (eg 26, can't read file/path)
+ ;; because the '=' test below fails for them
+ ;; they have the form (error . error message 24)
+ ((not (proper-list-p error-thrown)) ; not dotted list
+ (message "Got error: %s. Shit went south." (cdr error-thrown)))
+ ;; handle mastodon api errors
+ ;; they have the form (error http 401)
+ ((= (car (last error-thrown)) 401)
+ (message "Got error: %s Unauthorized: The access token is invalid"
+ error-thrown))
+ ((= (car (last error-thrown)) 422)
+ (message "Got error: %s Unprocessable entity: file or file\
+ type is unsupported or invalid"
+ error-thrown))
+ (t
+ (message "Got error: %s Shit went south"
+ error-thrown))))))))
+
+(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")
+
+(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))
+ (search-forward "\n\n")
+ (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))))
+
+(defun mastodon-media--process-full-sized-image-response (status-plist url)
+ ;; 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)))
+ (with-current-buffer (get-buffer-create "*masto-image*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert-image image str)
+ (special-mode) ; prevent image-mode loop bug
+ (image-mode)
+ (goto-char (point-min))
+ (switch-to-buffer-other-window (current-buffer))
+ (image-transform-fit-both))))))
+
+(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 font-lock-comment-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'/\\`i': load full image (prefix: copy URL), \\`+'/\\`-': zoom,\
+ \\`r': rotate, \\`o': save preview"
+ (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)
+
+(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")
+
+;; notifications defcustoms moved into mastodon.el
+;; as some need to be available without loading this file
+
+(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-notifications--types
+ '("all" "favourite" "reblog" "mention" "poll"
+ "follow_request" "follow" "status" "update")
+ ;; "severed_relationships" "moderation_warning")
+ "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))
+ "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"))
+ "Alist of subjects for notification types.")
+
+(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.")
+
+(defun mastodon-notifications--byline-action-str (message)
+ "Return an action (top) byline string for TOOT with MESSAGE."
+ (concat " "
+ (propertize message 'face 'mastodon-boosted-face)
+ " " (cdr (assoc message mastodon-notifications--response-alist))
+ "\n"))
+
+(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))
+
+(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 (font-lock-comment-face shr-text)))))
+ (buffer-string)))
+
+(defvar mastodon-notifications-grouped-types
+ '(follow reblog favourite)
+ "List of notification types for which grouping is implemented.")
+
+(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"))
+ "Action strings keyed by notification type.
+Types are those of the Mastodon API.")
+
+(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--severance-body (group)
+ "Return a body for a severance notification GROUP."
+ ;; FIXME: actually implement this when we encounter one in the wild!
+ (let-alist (alist-get 'event group)
+ (concat .type ": "
+ .target_name
+ "\nRelationships affected: "
+ .relationships_count)))
+
+(defun mastodon-notifications--mod-warning-body (group)
+ "Return a body for a moderation warning notification GROUP."
+ (let-alist (alist-get 'moderation_warning group)
+ (concat .action ": "
+ .text
+ "\nStatuses: "
+ .status_ids
+ "\nfor account: "
+ .target_account)))
+
+(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 (or (alist-get 'display_name follower)
+ (alist-get 'username 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)
+ ;; 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 (or (alist-get 'display_name follower)
+ (alist-get 'username 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--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 ((action-str
+ (unless (member type '(follow follow_request mention))
+ (downcase
+ (mastodon-notifications--byline-action-str
+ (alist-get type mastodon-notifications--action-alist)))))
+ (action-symbol (if (eq type 'mention)
+ ""
+ (mastodon-tl--symbol type)))
+ (action-authors
+ (if (member type '(follow follow_request mention))
+ "" ;; mentions are normal statuses
+ (if group
+ (mastodon-notifications--byline-accounts accounts group)
+ (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--body-arg
+ (type &optional filters status profile-note follower-name group)
+ "TYPE is a symbol, a member of `mastodon-notifiations--types'.
+FILTERS STATUS PROFILE-NOTE FOLLOWER-NAME GROUP."
+ (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
+ ((eq type 'follow)
+ (propertize "Congratulations, you have a new follower!"
+ 'face 'default))
+ ((eq type 'follow_request)
+ (concat
+ (propertize (format "You have a follow request from %s"
+ follower-name)
+ 'face 'default)
+ (when mastodon-profile-note-in-foll-reqs
+ (concat
+ ":\n"
+ (mastodon-notifications--comment-note-text body)))))
+ ((eq type 'severed_relationships)
+ (mastodon-notifications--severance-body group))
+ ((eq type 'moderation_warning)
+ (mastodon-notifications--mod-warning-body group))
+ ((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"
+ ;; actual byline:
+ (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")))
+
+(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.
+When DOMAIN, force inclusion of user's domain in their handle."
+ (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
+ ", ")))))))
+
+(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)
+ (if no-group
+ (cl-loop for x in json
+ do (mastodon-notifications--format-note x))
+ (let ((groups (alist-get 'notification_groups json)))
+ (cl-loop
+ for g in groups
+ for start-pos = (point)
+ for accounts = (mastodon-notifications--group-accounts
+ (alist-get 'sample_account_ids g)
+ (alist-get 'accounts json))
+ for status = (mastodon-notifications--alist-by-value
+ (or (alist-get 'status_id g)
+ ;; if no status_id, just try the first item?
+ (alist-get 'id
+ (car
+ (alist-get 'statuses json))))
+ 'id
+ (alist-get 'statuses 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--timeline (json &optional type)
+ "Format JSON in Emacs buffer.
+Optionally specify TYPE."
+ (if (seq-empty-p json)
+ (user-error "Looks like you have no (more) notifications for now")
+ (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")
+ (mastodon-notifications--render json (not mastodon-group-notifications))
+ (goto-char (point-min))
+ (mastodon-tl--goto-next-item)))
+
+(defun mastodon-notifications--get-type (&optional type)
+ "Read a notification type and load its timeline.
+Optionally specify TYPE."
+ (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--get-next-type ()
+ "Return the next notif type based on current buffer spec."
+ (let* ((update-params (mastodon-tl--buffer-property
+ 'update-params nil :no-error))
+ (type (alist-get "types[]" update-params nil nil #'equal)))
+ (if (not update-params)
+ (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))
+
+(defun mastodon-notifications--clear-all ()
+ "Clear all notifications."
+ (interactive)
+ (when (y-or-n-p "Clear all notifications?")
+ (let ((response
+ (mastodon-http--post (mastodon-http--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 (or (mastodon-tl--property 'notification-id) ;; grouped
+ (mastodon-tl--property 'item-id)
+ (mastodon-tl--field
+ 'id
+ (mastodon-tl--property 'item-json)))))
+ (endpoint (mastodon-http--api
+ (format "notifications/%s/dismiss" id)
+ "v2"))
+ (response (mastodon-http--post endpoint)))
+ (mastodon-http--triage
+ response (lambda (_)
+ (when mastodon-tl--buffer-spec
+ (mastodon-tl--reload-timeline-or-profile))
+ (message "Notification dismissed!")))))
+
+(defun mastodon-notifications--get-single-notif ()
+ "Return a single notification JSON for v2 notifs."
+ (interactive)
+ (let* ((id (mastodon-tl--property
+ 'notification-id)) ;; grouped, doesn't work for ungrouped!
+ ;; (key (format "ungrouped-%s"
+ ;; (mastodon-tl--property 'item-id)))
+ (endpoint (mastodon-http--api
+ (format "notifications/%s" id)
+ "v2"))
+ (response (mastodon-http--get-json endpoint)))
+ (mastodon-http--triage
+ response (lambda (_)
+ (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))
+ (resp (mastodon-http--get-json url)))
+ (alist-get 'count resp)))
+
+(provide 'mastodon-notifications)
+;;; mastodon-notifications.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "mastodon" "20241202.1839"
+ "Client for fediverse services using the Mastodon API."
+ '((emacs "28.1")
+ (request "0.3.0")
+ (persist "0.4")
+ (tp "0.6"))
+ :url "https://codeberg.org/martianh/mastodon.el"
+ :commit "10be1f9c2845a6012cee84b68dc566ea92df40a6"
+ :revdesc "10be1f9c2845"
+ :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)))
+
+;; TODO: we shd just load all views' data then switch coz this is slow af:
+(defun mastodon-profile--account-view-cycle (&optional prefix)
+ "Cycle through profile view: toots, toot sans boosts, followers, and following."
+ (interactive "P")
+ (if prefix
+ (let* ((choice
+ (completing-read "Profile view:"
+ mastodon-profile--account-view-alist))
+ (fun (alist-get choice mastodon-profile--account-view-alist
+ nil nil #'equal)))
+ (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 'font-lock-comment-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)))))
+
+
+;;; PROFILE WIDGET
+
+(defvar mastodon-profile--view-types
+ '(statuses no-boosts no-replies only-media followers following tag))
+
+(defvar mastodon-profile--load-funs-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-fun-call (type)
+ "Call the function associated with TYPE.
+Fetched from `mastodon-profile--load-funs-alist'."
+ (funcall
+ (alist-get type mastodon-profile--load-funs-alist)))
+
+\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."
+ (mapc (lambda (pinned-status)
+ (insert
+ (concat "\n "
+ (propertize " pinned "
+ 'face '(:inherit success :box t))
+ " "))
+ (mastodon-tl--toot pinned-status))
+ pinned-statuses))
+
+(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--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"
+ (propertize .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"
+ ;; 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
+ (let* ((followsp (mastodon-profile--follows-p
+ (list .requested_by .following .followed_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")
+ "\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)))
+ (mastodon-profile--view-fun-call value))))
+ (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"))
+ (mastodon-profile--insert-statuses-pinned pinned)
+ (setq mastodon-tl--update-point (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 (intern 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)
+ '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 (cl-remove nil
+ `(("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 'font-lock-comment-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'."
+ (mapc (lambda (acct)
+ (insert (concat (mastodon-search--propertize-user acct note)
+ mastodon-tl--horiz-bar
+ "\n\n")))
+ json))
+
+(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."
+ (mapc (lambda (el)
+ (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"))
+ tags-list))
+
+(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")
+
+(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)
+
+\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 . ("📊" . ""))
+ (follow . ("👤" . "+"))
+ (follow_request . ("👤" . "+")))
+ "A set of symbols (and fallback strings) to be used in timeline.
+If a symbol does not look right (tofu), it means your
+font settings do not support it."
+ :type '(alist :key-type symbol :value-type string))
+
+(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.'")
+
+\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 (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))
+ (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 ()
+ "Jump to previous item.
+Update if no previous items"
+ (interactive)
+ (condition-case nil
+ (mastodon-tl--goto-item-pos 'previous-single-property-change
+ '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
+ (cl-remove
+ nil
+ `(("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
+ (cl-remove
+ nil
+ `(("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--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
+ (propertize (if (not (string-empty-p .display_name))
+ .display_name
+ .username)
+ '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
+ (propertize (or string
+ (concat "@" .acct
+ (when domain
+ (concat "@"
+ (url-host
+ (url-generic-parse-url .url))))))
+ 'face (or face 'mastodon-handle-face)
+ 'mouse-face 'highlight
+ 'mastodon-tab-stop 'user-handle
+ 'shr-url .url
+ 'keymap mastodon-tl--link-keymap
+ '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 :url (or .remote_url .url) ; fallback for notifications
+ :type .type)))
+ media)))
+
+(defun mastodon-tl--byline-booster (toot)
+ "Add author byline for booster from TOOT.
+Only return something if TOOT contains a reblog."
+ (let ((reblog (alist-get 'reblog toot)))
+ (if reblog
+ (mastodon-tl--byline-author toot)
+ "")))
+
+(defun mastodon-tl--byline-booster-str (toot)
+ "Format boosted string for action byline.
+Only return string if TOOT contains a reblog."
+ (let ((reblog (alist-get 'reblog toot)))
+ (if reblog
+ (concat
+ " " (propertize "boosted" 'face 'mastodon-boosted-face) "\n")
+ "")))
+
+(defun mastodon-tl--byline-boost (toot)
+ "Format a boost action-byline element for TOOT."
+ (concat (mastodon-tl--byline-booster toot)
+ (mastodon-tl--byline-booster-str toot)))
+
+(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 'font-lock-comment-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)))))
+ (shr-render-region (point-min) (point-max)))
+ ;; 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 .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 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\"."
+ (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 (url-filename parsed-url)))
+ (when (and (string= "@" (substring buffer-text 0 1))
+ ;; don't error on domain only url (rare):
+ (not (string= "" path))
+ (string= (downcase buffer-text)
+ (downcase (substring path 1))))
+ (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))
+ (split (split-string path "/")))
+ (when (and (string= instance-host (url-host parsed))
+ (string-prefix-p "/tag" path)) ;; "/tag/" or "/tags/"
+ (nth 2 split))))
+
+\f
+;;; HYPERLINKS
+
+(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)))))
+ (propertize string
+ 'mastodon-tab-stop link-type
+ 'mouse-face 'highlight
+ 'keymap mastodon-tl--link-keymap
+ '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)))
+ (cond ((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 '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)))
+ (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"))))
+
+(defun mastodon-tl--view-full-image ()
+ "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)))
+ (if (not mastodon-tl--load-full-sized-images-in-emacs)
+ (shr-browse-image)
+ (mastodon-media--image-or-cached
+ url
+ #'mastodon-media--process-full-sized-image-response
+ `(nil ,url))))))
+
+(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 "\nPoll: \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 'font-lock-comment-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 'font-lock-comment-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)
+ (mapc (lambda (x)
+ (let ((att-type (plist-get x :type)))
+ (when (or (string= "video" att-type)
+ (string= "gifv" att-type))
+ (push x vids))))
+ attachments)
+ (car vids)))
+
+(defun mastodon-tl--mpv-play-video-from-byline ()
+ "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)))
+
+(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--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)))))
+ (insert
+ (propertize ;; body + byline:
+ (concat
+ (propertize ;; body only:
+ (concat
+ "\n"
+ (mastodon-tl--byline-boost toot) ;; top byline (boost)
+ ;; 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)))
+ (if (and after-reply-status-p thread)
+ (propertize body
+ 'line-prefix bar
+ 'wrap-prefix bar)
+ body))
+ (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
+ ;; 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))))
+ (mapc (lambda (toot)
+ (mastodon-tl--toot toot nil thread domain nil no-byline))
+ toots)
+ ;; 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 'font-lock-comment-face)
+ (propertize " | " 'face 'font-lock-comment-face)
+ (propertize boosts
+ 'boosted-p (eq t .reblogged)
+ 'boosts-field t
+ 'help-echo (format "%s boosts" .reblogs_count)
+ 'face 'font-lock-comment-face)
+ (propertize " | " 'face 'font-lock-comment-face)
+ (propertize replies
+ 'replies-field t
+ 'replies-count .replies_count
+ 'help-echo (format "%s replies" .replies_count)
+ 'face 'font-lock-comment-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)
+ ;; 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))))
+
+(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--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--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--single-toot (id)
+ "View toot at point in separate buffer.
+ID is that of the toot to view."
+ (interactive)
+ (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)
+ (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 id))))
+
+(defun mastodon-tl--thread (&optional thread-id)
+ "Open thread buffer for toot at point or with THREAD-ID.
+UNFOLDED STATE is a boolean of whether the thread (that we are
+reloading) is fully unfolded or folded, i.e. via
+`mastodon-tl--toggle-spoiler-in-thread'."
+ (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 thread-id)))
+
+(defun mastodon-tl--thread-do (&optional thread-id)
+ "Open thread buffer for toot at point or with THREAD-ID.
+UNFOLDED STATE is a boolean of whether the thread (that we are
+reloading) is fully unfolded or folded, i.e. via
+`mastodon-tl--toggle-spoiler-in-thread'.
+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 (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
+ nil nil nil nil id)
+ (when unfolded-state
+ (plist-put mastodon-tl--buffer-spec
+ 'thread-unfolded unfolded-state))
+ (mastodon-tl--timeline (alist-get 'ancestors context) :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)))
+ (mastodon-tl--timeline (alist-get 'descendants context)
+ :thread)
+ ;; put point at the toot:
+ (goto-char (marker-position marker))
+ (mastodon-tl--goto-next-item)))))))))
+
+(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? " (capitalize 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)))
+
+;; 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)))))))))
+
+\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--list-followed-tags (&optional prefix)
+ "List followed tags. View timeline of tag user choses.
+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--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)))
+
+\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 (cl-remove
+ nil
+ `(("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--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)
+ "Return JSON for timeline ENDPOINT since ID.
+PARAMS is used to send any parameters needed to correctly update
+the current view."
+ (let* ((args `(("since_id" . ,(mastodon-tl--as-string id))))
+ (args (append args params))
+ (url (mastodon-http--api endpoint)))
+ (mastodon-http--get-json url args)))
+
+;; TODO: add this to new posts in some cases, e.g. in thread view.
+(defun mastodon-tl--reload-timeline-or-profile (&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--get-toot-author max-id)))
+ ((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))))
+
+(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)))
+ (mastodon-tl--more-json-async
+ (mastodon-tl--endpoint)
+ max-id
+ (mastodon-tl--update-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."
+ (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)))
+ (goto-char (point-max))
+ (if (eq 'thread (mastodon-tl--get-buffer-type))
+ ;; if thread fully unfolded, respect it:
+ ;; if thread view, call --thread with parent ID
+ (progn (goto-char (point-min))
+ (mastodon-tl--goto-next-item)
+ (mastodon-tl--thread)
+ (goto-char point-before)
+ (message "Loaded full thread."))
+ (if (not json)
+ (user-error "No more results")
+ (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 nil nil 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):
+ (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-function (mastodon-tl--update-function)))
+ ;; update a thread, without calling `mastodon-tl--updated-json':
+ (if (mastodon-tl--buffer-type-eq 'thread)
+ ;; load whole thread:
+ (progn (mastodon-tl--thread)
+ (message "Loaded full thread."))
+ ;; update other timelines:
+ (let* ((id (mastodon-tl--newest-id))
+ (params (mastodon-tl--update-params))
+ (json (mastodon-tl--updated-json endpoint id params)))
+ (if (not 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)))
+ (funcall update-function 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.
+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 (mastodon-tl--set-face (concat "[" binding-str "]\n\n")
+ 'font-lock-comment-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."
+ (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)))
+
+;;; 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")
+
+;; 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 (| (any ?\( "\n" "\t "" ") bol) ; preceding things
+ (group-n 2 (+ ?@ (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; handle
+ (? ?@ (* (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 'vis 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-pp (concat
+ (mastodon-toot--str-negify action-str faved boosted)
+ (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)
+ "Add \"un\" to STR if FAVED or BOOSTED is non-nil."
+ (if (or faved boosted)
+ (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--open-toot-url ()
+ "Open URL of toot at point."
+ (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 (_)
+ (when mastodon-tl--buffer-spec
+ (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)
+ (emoji-search)))
+
+(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
+ (mapc (lambda (x)
+ (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))))
+ custom-emoji)
+ (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)
+ (mapc (lambda (x)
+ (push
+ `(,(concat ":"
+ (file-name-base x) ":")
+ . (("name" . ,(file-name-base x))
+ ("image" . ,(concat mastodon-custom-emojis-dir x))
+ ("style" . "github")))
+ mastodon-emojify-user-emojis))
+ custom-emoji-files)
+ (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.)
+ (when (or edit-id
+ (eq 'thread (mastodon-tl--get-buffer-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
+ .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 'font-lock-comment-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 'font-lock-comment-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 ()
+ "Change the current visibility to the next valid value."
+ (interactive)
+ (if (mastodon-tl--buffer-type-eq 'edit-toot)
+ (user-error "You can't change visibility when editing toots")
+ (setq mastodon-toot--visibility
+ (cond ((string= mastodon-toot--visibility "public")
+ "unlisted")
+ ((string= mastodon-toot--visibility "unlisted")
+ "private")
+ ((string= mastodon-toot--visibility "private")
+ "direct")
+ (t
+ "public")))
+ (mastodon-toot--update-status-fields)))
+
+(defun mastodon-toot--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) 600)
+ (car options))))) ;; min 5 mins
+
+(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 "--\\(.*\\)$")
+ (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 " ")
+ "%s"
+ (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 "\2"
+ (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 'tp)
+(require 'transient)
+
+(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")
+
+;;; 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 (_)
+ (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-c 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 (_) (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-c 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))))
+
+;;; CLASSES
+
+(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 'font-lock-comment-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."
+ (mapc (lambda (x)
+ (mastodon-views--print-list-accounts x)
+ (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n")
+ 'face 'success)))
+ lists))
+
+(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 'font-lock-comment-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
+
+(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 'font-lock-comment-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
+
+(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"))
+ (mapc (lambda (kw)
+ (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))))
+ kws)
+ ;; 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)))
+ ;; 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: 20241202.1839
+;; Package-Revision: 10be1f9c2845
+;; Package-Requires: ((emacs "28.1") (request "0.3.0") (persist "0.4") (tp "0.6"))
+;; 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)
+
+(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-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-tl--block-user "mastodon-tl")
+(autoload 'mastodon-tl--follow-user "mastodon-tl")
+(autoload 'mastodon-tl--followed-tags-timeline "mastodon-tl")
+(autoload 'mastodon-tl--get-buffer-type "mastodon-tl")
+(autoload 'mastodon-tl--get-federated-timeline "mastodon-tl")
+(autoload 'mastodon-tl--get-home-timeline "mastodon-tl")
+(autoload 'mastodon-tl--get-local-timeline "mastodon-tl")
+(autoload 'mastodon-tl--get-tag-timeline "mastodon-tl")
+(autoload 'mastodon-tl--goto-next-item "mastodon-tl")
+(autoload 'mastodon-tl--goto-prev-item "mastodon-tl")
+(autoload 'mastodon-tl--init-sync "mastodon-tl")
+(autoload 'mastodon-tl--list-followed-tags "mastodon-tl")
+(autoload 'mastodon-tl--mute-user "mastodon-tl")
+(autoload 'mastodon-tl--next-tab-item "mastodon-tl")
+(autoload 'mastodon-tl--poll-vote "mastodon-http")
+(autoload 'mastodon-tl--previous-tab-item "mastodon-tl")
+(autoload 'mastodon-tl--thread "mastodon-tl")
+(autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl")
+(autoload 'mastodon-tl--unblock-user "mastodon-tl")
+(autoload 'mastodon-tl--unfollow-user "mastodon-tl")
+(autoload 'mastodon-tl--unmute-user "mastodon-tl")
+(autoload 'mastodon-tl--report-to-mods "mastodon-tl")
+(autoload 'mastodon-tl--update "mastodon-tl")
+(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot")
+(when (require 'lingva nil :no-error)
+ (autoload 'mastodon-toot--translate-toot-text "mastodon-toot"))
+(autoload 'mastodon-toot--view-toot-history "mastodon-tl")
+(autoload 'mastodon-views--view-follow-suggestions "mastodon-views")
+(autoload 'mastodon-views--view-filters "mastodon-views")
+(autoload 'mastodon-views--view-follow-requests "mastodon-views")
+(autoload 'mastodon-views--view-instance-description "mastodon-views")
+(autoload 'mastodon-views--view-lists "mastodon-views")
+(autoload 'mastodon-views--view-scheduled-toots "mastodon-views")
+(autoload 'mastodon-tl--dm-user "mastodon-tl")
+(autoload 'mastodon-tl--scroll-up-command "mastodon-tl")
+(autoload 'special-mode "simple")
+(autoload 'mastodon-tl--thread-do "mastodon-tl")
+
+(defvar mastodon-tl--highlight-current-toot)
+(defvar mastodon-notifications--map)
+
+(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-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 "'") #'mastodon-tl--followed-tags-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 "@") #'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--open-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--thread)
+ (define-key map (kbd "m") #'mastodon-tl--dm-user)
+ (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)
+ ;; 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)
+ ;; 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 font-lock-comment-face))
+ "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 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))))
+
+;; 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 (query)
+ "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 query))
+ (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
+
+(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 mastodon-tl--highlight-current-toot
+ (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)
+
+* 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::
+* Customization::
+* Commands and variables index::
+* Alternative timeline layout::
+* mastodon hydra::
+* 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 AcitivityPub 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::
+* Customization::
+* Commands and variables index::
+* Alternative timeline layout::
+* mastodon hydra::
+* 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, delete the old file specified by
+‘mastodon-client--token-file’ and restart Emacs and follow the steps
+again.
+
+\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
+ *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--account-account-to-list’ (see lists view)
+ *Notifications view*
+ ‘a’, ‘j’ accept/reject follow request
+ ‘C-k’ clear notification at point
+ see ‘mastodon-notifications--get-*’ functions for filtered views
+ *Quitting*
+ ‘q’ Quit mastodon buffer, leave window open
+ ‘Q’ Quit mastodon buffer and kill window
+ ‘C-M-q’ Quit and kill all mastodon buffers
+
+ 2. Toot byline legend
+
+ Marker Meaning
+ --------------------------------------------
+ ‘(🔁)’ (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-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: Customization, Prev: Composing toots, Up: Usage
+
+1.2.4 Other commands and account settings:
+------------------------------------------
+
+In addition to ‘mastodon’, the following three functions are autoloaded
+and should work without first loading 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-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-profile--update-display-name’: Update the display name
+ for your account.
+ • ‘mastodon-profile--update-user-profile-note’: Update your bio note.
+ • ‘mastodon-profile--update-meta-fields’: Update your metadata
+ fields.
+ • ‘mastodon-profile--set-default-toot-visibility’: Set the default
+ visibility for your toots.
+ • ‘mastodon-profile--account-locked-toggle’: Toggle the locked status
+ of your account. Locked accounts have to manually approve follow
+ requests.
+ • ‘mastodon-profile--account-discoverable-toggle’: Toggle the
+ discoverable status of your account. Non-discoverable accounts are
+ not listed in the profile directory.
+ • ‘mastodon-profile--account-bot-toggle’: Toggle whether your account
+ is flagged as a bot.
+ • ‘mastodon-profile--account-sensitive-toggle’: Toggle whether your
+ posts are marked as sensitive (nsfw) by default.
+
+\1f
+File: mastodon.info, Node: Customization, Next: Commands and variables index, Prev: Other commands and account settings, Up: Usage
+
+1.2.5 Customization
+-------------------
+
+See ‘M-x customize-group RET mastodon’ to view all customize options.
+
+ • Timeline options:
+ • Use proportional fonts
+ • Default number of posts displayed
+ • Timestamp format
+ • Relative timestamps
+ • Display user avatars
+ • Avatar image height
+ • Enable image caching
+ • Hide replies in timelines
+ • Show toot stats in byline
+
+ • Compose options:
+ • Completion style for mentions and tags
+ • Enable custom emoji
+ • Display toot being replied to
+ • Set default reply visibility
+
+ • Nofitication options:
+ • Display user’s profile note in follow requests
+
+\1f
+File: mastodon.info, Node: Commands and variables index, Next: Alternative timeline layout, Prev: Customization, Up: Usage
+
+1.2.6 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: Alternative timeline layout, Next: mastodon hydra, Prev: Commands and variables index, Up: Usage
+
+1.2.7 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).
+
+\1f
+File: mastodon.info, Node: mastodon hydra, Next: Live-updating timelines mastodon-async-mode, Prev: Alternative timeline layout, Up: Usage
+
+1.2.8 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/>.
+
+\1f
+File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: mastodon hydra, 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
+
+ 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/))
+
+ 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. Create an issue (https://codeberg.org/martianh/mastodon.el/issues)
+ detailing what you’d like to do.
+ 2. Fork the repository and create a branch off of ‘develop’.
+ 3. Run the tests and ensure that your code doesn’t break any of them.
+ 4. Create a pull request (to develop) referencing the issue created in
+ step 1.
+
+\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). If you would prefer a different payment
+method, please write to me at <mousebotNOSPAMdisroot.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\7f1006
+Node: Installation\7f1656
+Node: ELPA\7f1945
+Node: MELPA\7f2173
+Node: Repo\7f2553
+Node: Emoji\7f3046
+Node: Discover\7f3640
+Node: Usage\7f4192
+Node: Logging in to your instance\7f4654
+Node: Timelines\7f5651
+Ref: Keybindings\7f6126
+Ref: Toot byline legend\7f10966
+Node: Composing toots\7f11275
+Ref: Keybindings (1)\7f12827
+Ref: Autocompletion of mentions tags and emoji\7f13362
+Ref: Draft toots\7f14287
+Node: Other commands and account settings\7f14758
+Node: Customization\7f18122
+Node: Commands and variables index\7f19000
+Node: Alternative timeline layout\7f19516
+Node: mastodon hydra\7f19892
+Node: Live-updating timelines mastodon-async-mode\7f20224
+Node: Translating toots\7f21063
+Node: Bookmarks and mastodonel\7f22247
+Node: Dependencies\7f22789
+Node: Network compatibility\7f23423
+Node: Contributing\7f24305
+Node: Bug reports\7f24801
+Node: Fixes and features\7f25712
+Node: Coding style\7f26213
+Node: Supporting mastodonel\7f26837
+Node: Contributors\7f27389
+Node: screenshots\7f27824
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
projects / emacsconfig.git / commitdiff