From: Andreas Gerler Date: Sun, 26 Apr 2026 17:59:04 +0000 (+0200) Subject: update mastodon X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=fdd71200cd63b2bd5a60e15010781ce7c816cce2;p=emacsconfig.git update mastodon --- diff --git a/elpa/mastodon-20251201.1553/dir b/elpa/mastodon-20251201.1553/dir deleted file mode 100644 index 28d21f79..00000000 --- a/elpa/mastodon-20251201.1553/dir +++ /dev/null @@ -1,19 +0,0 @@ -This is the file .../info/dir, which contains the -topmost node of the Info hierarchy, called (dir)Top. -The first time you invoke Info you start off looking at this node. - -File: dir, Node: Top This is the top of the INFO tree - - This (the Directory node) gives a menu of major topics. - Typing "q" exits, "H" lists all Info commands, "d" returns here, - "h" gives a primer for first-timers, - "mEmacs" 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. diff --git a/elpa/mastodon-20251201.1553/mastodon-async.el b/elpa/mastodon-20251201.1553/mastodon-async.el deleted file mode 100644 index b059407d..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-async.el +++ /dev/null @@ -1,362 +0,0 @@ -;;; mastodon-async.el --- Async streaming functions for mastodon.el -*- lexical-binding: t -*- - -;; Copyright (C) 2017 Alex J. Griffith -;; Author: Alex J. Griffith -;; Maintainer: Marty Hiatt -;; 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 . - -;;; 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 diff --git a/elpa/mastodon-20251201.1553/mastodon-auth.el b/elpa/mastodon-20251201.1553/mastodon-auth.el deleted file mode 100644 index 2902c319..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-auth.el +++ /dev/null @@ -1,321 +0,0 @@ -;;; mastodon-auth.el --- Auth functions for mastodon.el -*- lexical-binding: t -*- - -;; Copyright (C) 2017-2019 Johnson Denen -;; Copyright (C) 2021 Abhiseck Paira -;; Copyright (C) 2025 Marty Hiatt -;; Author: Johnson Denen -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-auth.el supports authorizing and authenticating with Mastodon. - -;;; Code: - -(require 'plstore) -(require 'auth-source) -(require 'json) -(require 'url) - -(eval-when-compile (require 'subr-x)) ; for if-let* - -(autoload 'mastodon-client "mastodon-client") -(autoload 'mastodon-client--active-user "mastodon-client") -(autoload 'mastodon-client--form-user-from-vars "mastodon-client") -(autoload 'mastodon-client--make-user-active "mastodon-client") -(autoload 'mastodon-client--store-access-token "mastodon-client") -(autoload 'mastodon-http--api "mastodon-http") -(autoload 'mastodon-http--concat-params-to-url "mastodon-http") -(autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-return-credential-account "mastodon") -(autoload 'mastodon-client--general-read "mastodon-client") -(autoload 'mastodon-client--token-file "mastodon-client") - -(defvar mastodon-instance-url) -(defvar mastodon-client-scopes) -(defvar mastodon-client-redirect-uri) -(defvar mastodon-active-user) - -(defgroup mastodon-auth nil - "Authenticate with Mastodon." - :prefix "mastodon-auth-" - :group 'mastodon) - -(defcustom mastodon-auth-use-auth-source t - "Whether to use auth sources for user credentials. -If t, save and read user access token in the user's auth source -file (see `auth-sources'). If nil, use `mastodon-client--token-file' -instead. -If you change the value of this variable, call -`mastodon-forget-all-logins' and log in again. -If for some reason you generate a new token, you'll have to update your -auth souce file manually, or at least remove the entry and authenticate -again, as auth-source.el only provides unreliable tools for updating -entries." - :type 'boolean) - -(defvar mastodon-auth-source-file nil - "This variable is obsolete. -This variable currently serves no purpose and will be removed in -the future.") - -(defvar mastodon-auth--token-alist nil - "Alist of User access tokens keyed by instance url.") - -(defvar mastodon-auth--acct-alist nil - "Alist of account accts (name@domain) keyed by instance url.") - -(defvar mastodon-auth--user-unaware - " ** MASTODON.EL - NOTICE ** - -User variables not set: mastodon.el requires that you set both -`mastodon-active-user' and `mastodon-instance-url' in your init file. - -Please see its documentation to understand what value it accepts -by running M-x describe-variable on it or visiting our web page: -https://codeberg.org/martianh/mastodon.el. -") - -(defun mastodon-auth--get-browser-login-url () - "Return properly formed browser login url." - (let ((client-id (plist-get (mastodon-client) :client_id))) - (if (not client-id) - (error "Failed to set up client id") - (mastodon-http--concat-params-to-url - (concat mastodon-instance-url "/oauth/authorize/") - `(("response_type" . "code") - ("redirect_uri" . ,mastodon-client-redirect-uri) - ("scope" . ,mastodon-client-scopes) - ("client_id" . ,client-id)))))) - -(defvar mastodon-auth--explanation - (format - " -1. A URL has been copied to your clipboard. Open this URL in a -javascript capable browser and your browser will take you to your -Mastodon instance's login page. - -2. Login to your account (%s) and authorize \"mastodon.el\". - -3. After authorization you will be presented an authorization -code. Copy this code and paste it in the minibuffer prompt." - (mastodon-client--form-user-from-vars))) - -(defun mastodon-auth--show-notice (notice buffer-name &optional ask) - "Display NOTICE to user. -By default NOTICE is displayed in vertical split occupying 50% of total -width. The buffer name of the buffer being displayed in the -window is BUFFER-NAME. -When optional argument ASK is given which should be a string, use -ASK as the minibuffer prompt. Return whatever user types in -response to the prompt. -When ASK is absent return nil." - (let ((buffer (get-buffer-create buffer-name)) - (inhibit-read-only t) - ask-value window) - (set-buffer buffer) - (erase-buffer) - (insert notice) - (fill-region (point-min) (point-max)) - (read-only-mode) - - (setq window (select-window - (split-window (frame-root-window) nil 'below) - t)) - (switch-to-buffer buffer t) - (when ask - (setq ask-value (read-string ask)) - (kill-buffer buffer) - (delete-window window)) - ask-value)) - -(defun mastodon-auth--request-authorization-code () - "Ask authorization code and return it." - (let ((url (mastodon-auth--get-browser-login-url)) - (select-enable-clipboard t) - authorization-code) - (kill-new url) - (message "%s" url) - (setq authorization-code - (mastodon-auth--show-notice mastodon-auth--explanation - "*mastodon-notice*" - "Authorization Code: ")) - authorization-code)) - -(defun mastodon-auth--generate-token () - "Generate access_token for the user. Return response buffer." - (let ((authorization-code (mastodon-auth--request-authorization-code))) - (mastodon-http--post - (concat mastodon-instance-url "/oauth/token") - `(("grant_type" . "authorization_code") - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("code" . ,authorization-code) - ("redirect_uri" . ,mastodon-client-redirect-uri)) - nil - :unauthenticated))) - -(defun mastodon-auth--get-token () - "Make a request to generate an auth token and return JSON response." - (with-current-buffer (mastodon-auth--generate-token) - (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let ((json-object-type 'plist) - (json-key-type 'keyword) - (json-array-type 'vector) - (json-string (buffer-substring-no-properties (point) (point-max)))) - (json-read-from-string json-string)))) - -(defun mastodon-auth--plstore-token-check (&optional auth-source) - "Signal an error if plstore contains unencrypted access-token. -If AUTH-SOURCE, and if `mastodon-auth-use-auth-source' is non-nil, -return non-nil if it contains any access token. -Used to help users switch to the new encrypted auth token flow." - ;; FIXME: is it poss to move this plstore read to have one less read? - ;; e.g. inside of `mastodon-client--active-user'? the issue is that - ;; ideally we want to test "user-" entry, even if fetching "active-user" - ;; entry, so we would have to re-do the plstore read functions. - (when - (mastodon-auth--plstore-access-token-member auth-source) - (if auth-source - (user-error "Auth source storage of tokens is enabled,\ - but there is also an access token in your plstore.\ - If you're seeing this message after updating,\ - call `mastodon-forget-all-logins', and try again. - If you don't want to use auth sources,\ - also set `mastodon-auth-use-auth-source' to nil.\ - If this message is in error, contact us on the mastodon.el repo") - (user-error "Unencrypted access token in your plstore.\ - If you're seeing this message after updating,\ - call `mastodon-forget-all-logins', and log in again. - If this message is in error, contact us on the mastodon.el repo")))) - -(defun mastodon-auth--plstore-access-token-member (&optional auth-source) - "Return non-nil if the user entry of the plstore contains :access_token. -If AUTH-SOURCE, also check if it contains :secret-access_token." - (let* ((plstore (plstore-open (mastodon-client--token-file))) - (name (concat "user-" (mastodon-client--form-user-from-vars))) - ;; get alist like plstore.el does, so that keys will display with - ;; ":secret-" prefix if encrypted: - (alist (assoc name (plstore--get-merged-alist plstore)))) - (if (and auth-source mastodon-auth-use-auth-source) - (or (member :access_token alist) - (member :secret-access_token alist)) - (member :access_token alist)))) - -(defun mastodon-auth--access-token () - "Return the access token to use with `mastodon-instance-url'. -Generate/save token if none known yet." - (cond - (mastodon-auth--token-alist - ;; user variables are known and initialised. - (alist-get mastodon-instance-url - mastodon-auth--token-alist nil nil #'string=)) - ;; if auth source enabled, but we have an access token in plstore, - ;; error out and tell user to remove plstore and start over or disable - ;; auth source: - ((mastodon-auth--plstore-token-check)) - ((plist-get (mastodon-client--active-user) :access_token) - ;; user variables need to be read from plstore active-user entry. - (push (cons mastodon-instance-url - (plist-get (mastodon-client--active-user) :access_token)) - mastodon-auth--token-alist) - (alist-get mastodon-instance-url - mastodon-auth--token-alist nil nil #'string=)) - ((null mastodon-active-user) - ;; user not aware of 2FA-related changes and has not set - ;; `mastodon-active-user'. Make user aware and error out. - (mastodon-auth--show-notice mastodon-auth--user-unaware - "*mastodon-notice*") - (user-error "Variables not set properly")) - (t - ;; user access-token needs to fetched from the server and - ;; stored and variables initialised. - (mastodon-auth--handle-token-response (mastodon-auth--get-token))))) - -(defun mastodon-auth--handle-token-response (response) - "Add token RESPONSE to `mastodon-auth--token-alist'. -The token is returned by `mastodon-auth--get-token'. -Handle any errors from the server." - (pcase response - ((and (let token (plist-get response :access_token)) - (guard token)) - (mastodon-client--make-user-active - (mastodon-client--store-access-token token)) - (cdar (push (cons mastodon-instance-url token) - mastodon-auth--token-alist))) - (`(:error ,class :error_description ,error) - (error "Mastodon-auth--access-token: %s: %s" class error)) - (_ (error "Unknown response from mastodon-auth--get-token!")))) - -(defun mastodon-auth-source-get (user host &optional token create) - "Fetch an auth source token, searching by USER and HOST. -If CREATE, use TOKEN or prompt for it, and save it if there is no such entry. -Return a list of user, password/secret, and the item's save-function." - (let* ((auth-source-creation-prompts - '((secret . "%u access token: "))) - (source - (car - (auth-source-search :host host :user user - :require '(:user :secret) - :secret (if token token nil) - ;; "create" alone doesn't work here!: - :create (if create t nil))))) - (when source - (let ((creds - `(,(plist-get source :user) - ,(auth-info-password source) - ,(plist-get source :save-function)))) - (when create ;; call save function: - (when (functionp (nth 2 creds)) - (funcall (nth 2 creds)))) - creds)))) - -(defun mastodon-auth-source-token (url handle &optional token create) - "Parse URL, search auth sources with it, user HANDLE and TOKEN. -Calls `mastodon-auth-source-get', returns only the token. -If CREATE, create an entry is none is found." - (let ((host (url-host - (url-generic-parse-url url))) - (username (car (split-string handle "@")))) - (nth 1 - (mastodon-auth-source-get username host token create)))) - -(defun mastodon-auth--get-account-name () - "Request user credentials and return an account name." - (alist-get 'acct - (mastodon-return-credential-account))) - -(defun mastodon-auth--get-account-id () - "Request user credentials and return an account name." - (alist-get 'id - (mastodon-return-credential-account))) - -(defun mastodon-auth--user-acct () - "Return a mastodon user acct name." - (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist)) - (let ((acct (mastodon-auth--get-account-name))) - (push (cons mastodon-instance-url acct) mastodon-auth--acct-alist) - acct))) - -(provide 'mastodon-auth) -;;; mastodon-auth.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-autoloads.el b/elpa/mastodon-20251201.1553/mastodon-autoloads.el deleted file mode 100644 index d94babd3..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-autoloads.el +++ /dev/null @@ -1,162 +0,0 @@ -;;; 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))) - - - -;;; Generated autoloads from mastodon.el - -(autoload 'mastodon-forget-all-logins "mastodon" "\ -Delete `mastodon-client--token-file'. -Also nil `mastodon-auth--token-alist'." t) -(autoload 'mastodon "mastodon" "\ -Connect client to `mastodon-instance-url' instance. -If there are any open mastodon.el buffers, switch to one instead. -Prority in switching is given to timeline views." t) -(autoload 'mastodon-toot "mastodon" "\ -Update instance with new toot. Content is captured in a new buffer. -If USER is non-nil, insert after @ symbol to begin new toot. -If REPLY-TO-ID is non-nil, attach new toot to a conversation. -If REPLY-JSON is the json of the toot being replied to. - -(fn &optional USER REPLY-TO-ID REPLY-JSON)" t) -(autoload 'mastodon-notifications-get "mastodon" "\ -Display NOTIFICATIONS in buffer. -Optionally only print notifications of type TYPE, a string. -BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. -MAX-ID is a request parameter for pagination. - -(fn &optional TYPE BUFFER-NAME MAX-ID)" t) -(autoload 'mastodon-url-lookup "mastodon" "\ -If a URL resembles a fediverse link, try to load in `mastodon.el'. -Does a WebFinger lookup on the server. -URL can be arg QUERY-URL, or URL at point, or provided by the user. -If a status or account is found, load it in `mastodon.el', if -not, just browse the URL in the normal fashion. -If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'. - -(fn &optional QUERY-URL FORCE)" t) -(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun) -(register-definition-prefixes "mastodon" '("mastodon-")) - - -;;; 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--")) - - -;;; Generated autoloads from mastodon-auth.el - -(register-definition-prefixes "mastodon-auth" '("mastodon-auth-")) - - -;;; Generated autoloads from mastodon-client.el - -(register-definition-prefixes "mastodon-client" '("mastodon-client")) - - -;;; Generated autoloads from mastodon-discover.el - -(register-definition-prefixes "mastodon-discover" '("mastodon-discover")) - - -;;; Generated autoloads from mastodon-http.el - -(register-definition-prefixes "mastodon-http" '("mastodon-http--")) - - -;;; Generated autoloads from mastodon-inspect.el - -(register-definition-prefixes "mastodon-inspect" '("mastodon-inspect--")) - - -;;; Generated autoloads from mastodon-iso.el - -(register-definition-prefixes "mastodon-iso" '("mastodon-iso-639-")) - - -;;; Generated autoloads from mastodon-media.el - -(register-definition-prefixes "mastodon-media" '("mastodon-media--")) - - -;;; Generated autoloads from mastodon-notifications.el - -(register-definition-prefixes "mastodon-notifications" '("mastodon-")) - - -;;; Generated autoloads from mastodon-profile.el - -(register-definition-prefixes "mastodon-profile" '("mastodon-profile-")) - - -;;; Generated autoloads from mastodon-search.el - -(register-definition-prefixes "mastodon-search" '("mastodon-search-")) - - -;;; Generated autoloads from mastodon-tl.el - -(register-definition-prefixes "mastodon-tl" '("mastodon-" "with-mastodon-buffer")) - - -;;; 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")) - - -;;; Generated autoloads from mastodon-transient.el - -(register-definition-prefixes "mastodon-transient" '("mastodon-")) - - -;;; Generated autoloads from mastodon-views.el - -(autoload 'mastodon-views-view-scheduled-toots "mastodon-views" "\ -Show the user's scheduled toots in a new buffer." t) -(autoload 'mastodon-views-view-filters "mastodon-views" "\ -View the user's filters in a new buffer." t) -(register-definition-prefixes "mastodon-views" '("mastodon-views-")) - - -;;; Generated autoloads from mastodon-widget.el - -(register-definition-prefixes "mastodon-widget" '("mastodon-widget-")) - -;;; 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 diff --git a/elpa/mastodon-20251201.1553/mastodon-client.el b/elpa/mastodon-20251201.1553/mastodon-client.el deleted file mode 100644 index 1ad6d2be..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-client.el +++ /dev/null @@ -1,262 +0,0 @@ -;;; mastodon-client.el --- Client functions for mastodon.el -*- lexical-binding: t -*- - -;; Copyright (C) 2017-2019 Johnson Denen -;; Copyright (C) 2021 Abhiseck Paira -;; Copyright (C) 2025 Marty Hiatt -;; Author: Johnson Denen -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-client.el supports registering the Emacs client with your Mastodon instance. - -;;; Code: - -(require 'plstore) -(require 'json) -(require 'url) - -(defvar mastodon-instance-url) -(defvar mastodon-active-user) -(defvar mastodon-auth-use-auth-source) - -(autoload 'mastodon-http--api "mastodon-http") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-auth-source-token "mastodon-auth") - -(defcustom mastodon-client--token-file - (concat user-emacs-directory "mastodon.plstore") - "File path where Mastodon access tokens are stored." - :group 'mastodon - :type 'file) - -(defvar mastodon-client--client-details-alist nil - "An alist of Client id and secrets keyed by the instance url.") - -(defvar mastodon-client--active-user-details-plist nil - "A plist of active user details.") - -(defvar mastodon-client-scopes "read write follow" - "Scopes to pass to oauth during registration.") - -(defvar mastodon-client-website "https://codeberg.org/martianh/mastodon.el" - "Website of mastodon.el.") - -(defvar mastodon-client-redirect-uri "urn:ietf:wg:oauth:2.0:oob" - "Redirect_uri as required by oauth.") - -(defun mastodon-client--register () - "POST client to Mastodon." - (mastodon-http--post (mastodon-http--api "apps") - `(("client_name" . "mastodon.el") - ("redirect_uris" . ,mastodon-client-redirect-uri) - ("scopes" . ,mastodon-client-scopes) - ("website" . ,mastodon-client-website)) - nil - :unauthenticated)) - -(defun mastodon-client--fetch () - "Return JSON from `mastodon-client--register' call." - (let ((buf (mastodon-client--register))) - (if (not buf) - (user-error "Client registration failed.\ - Is `mastodon-instance-url' correct?") - (with-current-buffer buf - (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let* ((json-object-type 'plist) - (json-key-type 'keyword) - (json-array-type 'vector) - (json-string - (buffer-substring-no-properties (point) (point-max))) - (parsed - (json-read-from-string json-string))) - (if (eq :error (car parsed)) - (error "Error: %s" (cadr parsed)) - parsed)))))) - -(defun mastodon-client--token-file () - "Return `mastodon-client--token-file'." - mastodon-client--token-file) - -(defun mastodon-client--store () - "Store client_id and client_secret in `mastodon-client--token-file'. -Make `mastodon-client--fetch' call to determine client values. -Return a plist of secret and non-secret key/val pairs." - (let* ((plstore (plstore-open (mastodon-client--token-file))) - (client (mastodon-client--fetch)) - (secrets `( :client_id ,(plist-get client :client_id) - :client_secret ,(plist-get client :client_secret))) - (sans-secrets - (dolist (x '(:client_id :client_secret) client) - (cl-remf client x))) - ;; alexgriffith reported seeing ellipses in the saved output - ;; which indicate some output truncating. Nothing in - ;; `plstore-save' seems to ensure this cannot happen so let's do - ;; that ourselves: - (print-length nil) - (print-level nil)) - (plstore-put plstore - (concat "mastodon-" mastodon-instance-url) - sans-secrets secrets) - ;; FIXME: breaks tests: prompts for gpg passphrase - (plstore-save plstore) - (plstore-close plstore) - (append secrets sans-secrets))) - -(defun mastodon-client--remove-key-from-plstore (plstore) - "Remove KEY from PLSTORE." - (cdr plstore)) - -;; Actually it returns a plist with client-details if such details are -;; already stored in mastodon.plstore -(defun mastodon-client--read () - "Retrieve client_id and client_secret from `mastodon-client--token-file'." - (let* ((plstore (plstore-open (mastodon-client--token-file))) - (mastodon - (plstore-get plstore - (concat "mastodon-" mastodon-instance-url)))) - (plstore-close plstore) - (mastodon-client--remove-key-from-plstore mastodon))) - -(defun mastodon-client--general-read (key) - "Retrieve the plstore item keyed by KEY. -Return plist without the KEY." - (let* ((plstore (plstore-open (mastodon-client--token-file))) - (plstore-item (plstore-get plstore key))) - (plstore-close plstore) - (mastodon-client--remove-key-from-plstore plstore-item))) - -(defun mastodon-client--make-user-details-plist () - "Make a plist with current user details. Return it." - `( :username ,(mastodon-client--form-user-from-vars) - :instance ,mastodon-instance-url - :client_id ,(plist-get (mastodon-client) :client_id) - :client_secret ,(plist-get (mastodon-client) :client_secret))) - -(defun mastodon-client--store-access-token (token) - "Save TOKEN as :access_token encrypted in the plstore. -Return the plist after the operation. -If `mastodon-auth-use-auth-source', encrypt it in auth source file." - (let* ((user-details (mastodon-client--make-user-details-plist)) - (plstore (plstore-open (mastodon-client--token-file))) - (username (mastodon-client--form-user-from-vars)) - (key (concat "user-" username)) - (secrets `( :client_id ,(plist-get user-details :client_id) - :client_secret ,(plist-get user-details :client_secret))) - (sans-secrets - (dolist (x '(:client_id :client_secret) user-details) - (cl-remf user-details x))) - (print-length nil) - (print-level nil)) - (if mastodon-auth-use-auth-source - ;; auth-source: - (progn - (mastodon-auth-source-token - mastodon-instance-url username token :create) - (plstore-put plstore key sans-secrets secrets)) - ;; plstore encrypted: - (plstore-put plstore key sans-secrets - (append secrets `(:access_token ,token)))) - (plstore-save plstore) - (plstore-close plstore) - (cdr (plstore-get plstore key)))) - -(defun mastodon-client--make-user-active (user-details) - "USER-DETAILS is a plist consisting of user details. -Save it to plstore under key \"active-user\". -If `mastodon-auth-use-auth-source' is non-nil, fetch the access token -from the user's auth source file and add it to the active user entry. -Return a plist of secret and non-secret key/val pairs." - (let* ((plstore (plstore-open (mastodon-client--token-file))) - (handle (plist-get user-details :username)) - (token - (if mastodon-auth-use-auth-source - (mastodon-auth-source-token mastodon-instance-url handle) - (plist-get user-details :access_token))) - (secrets `( :access_token ,token - :client_id ,(plist-get user-details :client_id) - :client_secret ,(plist-get user-details :client_secret))) - (deets (copy-sequence user-details)) - (sans-secrets - (dolist (x '(:client_id :client_secret :access_token) deets) - (cl-remf deets x))) - (print-length nil) - (print-level nil)) - (plstore-put plstore "active-user" sans-secrets secrets) - (plstore-save plstore) - (plstore-close plstore) - (append secrets sans-secrets))) - -(defun mastodon-client--form-user-from-vars () - "Create a username from user variable. Return that username. -Username in the form user@instance.com is formed from the -variables `mastodon-instance-url' and `mastodon-active-user'." - (concat mastodon-active-user - "@" - (url-host (url-generic-parse-url mastodon-instance-url)))) - -(defun mastodon-client--make-current-user-active () - "Make the user specified by user variables active user. -Return the details (plist)." - (let* ((username (mastodon-client--form-user-from-vars)) - (user-plist (mastodon-client--general-read - (concat "user-" username)))) - (when user-plist - (mastodon-client--make-user-active user-plist) - user-plist))) - -(defun mastodon-client--current-user-active-p () - "Return user-details if the current user is active. -Otherwise return nil." - (let ((username (mastodon-client--form-user-from-vars)) - (user-details (mastodon-client--general-read "active-user"))) - (when (and user-details - (string= (plist-get user-details :username) username)) - user-details))) - -(defun mastodon-client--active-user () - "Return the details of the currently active user. -Details is a plist." - (or mastodon-client--active-user-details-plist - (setq mastodon-client--active-user-details-plist - (or (mastodon-client--current-user-active-p) - (mastodon-client--make-current-user-active))))) - -(defun mastodon-client () - "Return variable client secrets to use for `mastodon-instance-url'. -If `mastodon-client--client-details-alist' is nil, read plist from -`mastodon-client--token-file'. -Fetch and store plist if `mastodon-client--read' returns nil. -Return a plist." - (let ((client-details - (cdr (assoc mastodon-instance-url - mastodon-client--client-details-alist)))) - (or client-details - (let ((client-details (or (mastodon-client--read) - (mastodon-client--store)))) - (push (cons mastodon-instance-url client-details) - mastodon-client--client-details-alist) - client-details)))) - -(provide 'mastodon-client) -;;; mastodon-client.el ends here - diff --git a/elpa/mastodon-20251201.1553/mastodon-discover.el b/elpa/mastodon-20251201.1553/mastodon-discover.el deleted file mode 100644 index 81dc3937..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-discover.el +++ /dev/null @@ -1,125 +0,0 @@ -;;; 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 -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; This adds optional functionality that can be used if the dicover package -;; is present. -;; -;; See the README file for how to use this. - -;;; Code: - -(declare-function discover-add-context-menu "discover") - -(autoload 'mastodon-kill-window "mastodon") - -(defun mastodon-discover () - "Plug Mastodon functionality into `discover'." - (interactive) - (when (require 'discover nil :noerror) - (discover-add-context-menu - :bind "?" - :mode 'mastodon-mode - :mode-hook 'mastodon-mode-hook - :context-menu - '(mastodon - (description "Mastodon feed viewer") - (actions - ("Toots" - ("A" "View profile of author" mastodon-profile-get-toot-author) - ("b" "Boost" mastodon-toot--boost) - ("f" "Favourite" mastodon-toot--favourite) - ("c" "Toggle hidden text (CW)" mastodon-tl-toggle-spoiler-text-in-toot) - ("k" "Bookmark toot" mastodon-toot-toggle-bookmark) - ("v" "Vote on poll" mastodon-tl-poll-vote) - ("n" "Next" mastodon-tl-goto-next-item) - ("p" "Prev" mastodon-tl-goto-prev-item) - ("TAB" "Next link item" mastodon-tl-next-tab-item) - ("S-TAB" "Prev link item" mastodon-tl-previous-tab-item) - ;; NB: (when (require 'mpv etc. calls don't work here - ("C-RET" "Play media" mastodon-tl-mpv-play-video-at-point) - ("t" "New toot" mastodon-toot) - ("r" "Reply" mastodon-toot-reply) - ("C" "Copy toot URL" mastodon-toot-copy-toot-url) - ("o" "Open toot URL" mastodon-toot-browse-toot-url) - ("d" "Delete (your) toot" mastodon-toot-delete-toot) - ("D" "Delete and redraft (your) toot" mastodon-toot-delete-toot) - ("e" "Edit (your) toot" mastodon-toot-edit-toot-at-point) - ("E" "View edits of (your) toot" mastodon-toot-view-toot-edits) - ("i" "Pin/Unpin (your) toot" mastodon-toot-pin-toot-toggle) - ("P" "View user profile" mastodon-profile-show-user) - ("a" "Translate toot at point" mastodon-toot-translate-toot-text) - ("T" "View thread" mastodon-tl-thread) - ("v" "Vote on poll" mastodon-tl-poll-vote) - ("," "View toot's favouriters" mastodon-toot--list-toot-favouriters) - ("." "View toot's boosters" mastodon-toot--list-toot-boosters) - ("/" "Switch buffers" mastodon-switch-to-buffer)) - ("Views" - ("h/?" "View mode help/keybindings" describe-mode) - ("#" "Tag search" mastodon-tl-get-tag-timeline) - ("\"" "List followed tags" mastodon-tl-list-followed-tags) - ("'" "Followed tags timeline" mastodon-tl-followed-tags-timeline) - ("F" "Federated" mastodon-tl-get-federated-timeline) - ("H" "Home" mastodon-tl-get-home-timeline) - ("L" "Local" mastodon-tl-get-local-timeline) - ("N" "Notifications" mastodon-notifications-get) - ("@" "Notifications with mentions" mastodon-notifications-get-mentions) - ("g/u" "Update timeline" mastodon-tl-update) - ("s" "Search" mastodon-search-query) - ("O" "Jump to your profile" mastodon-profile-my-profile) - ("U" "Update your profile note" mastodon-profile-update-user-profile-note) - ("K" "View bookmarks" mastodon-profile-view-bookmarks) - ("V" "View favourites" mastodon-profile-view-favourites) - ("R" "View follow requests" mastodon-profile--view-follow-requests) - ("G" "View follow suggestions" mastodon-tl--get-follow-suggestions) - ("I" "View filters" mastodon-tl--view-filters) - ("X" "View lists" mastodon-tl--view-lists) - ("S" "View scheduled toots" mastodon-tl--view-scheduled-toots) - (";" "View instance description" mastodon-tl--view-instance-description)) - ("Users" - ("W" "Follow" mastodon-tl-follow-user) - ("C-S-W" "Unfollow" mastodon-tl-unfollow-user) - ("M" "Mute" mastodon-tl-mute-user) - ("C-S-M" "Unmute" mastodon-tl-unmute-user) - ("B" "Block" mastodon-tl-block-user) - ("C-S-B" "Unblock" mastodon-tl-unblock-user)) - ("Images" - ;; RET errors here also :/ - ("/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 diff --git a/elpa/mastodon-20251201.1553/mastodon-http.el b/elpa/mastodon-20251201.1553/mastodon-http.el deleted file mode 100644 index fc456925..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-http.el +++ /dev/null @@ -1,435 +0,0 @@ -;;; 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 -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-http.el provides HTTP request/response functions. - -;;; Code: - -(require 'json) -(require 'url) -(require 'url-http) -(require 'shr) - -(defvar mastodon-instance-url) -(defvar mastodon-toot--media-attachment-ids) -(defvar mastodon-toot--media-attachment-filenames) - -(autoload 'mastodon-auth--access-token "mastodon-auth") -(autoload 'mastodon-toot--update-status-fields "mastodon-toot") -(autoload 'url-insert "url-handlers") - -(defvar mastodon-http--api-version "v1") - -(defconst mastodon-http--timeout 15 - "HTTP request timeout, in seconds. Has no effect on Emacs < 26.1.") - -(defun mastodon-http--api (endpoint &optional version) - "Return Mastodon API URL for ENDPOINT. -Optionally specify VERSION in format vX." - (concat mastodon-instance-url "/api/" - (or version mastodon-http--api-version) "/" endpoint)) - -(defun mastodon-http--api-v2 (endpoint) - "Return Mastodon API v2 URL for ENDPOINT." - (mastodon-http--api endpoint "v2")) - -(defun mastodon-http--url-retrieve-synchronously (url &optional silent) - "Retrieve URL asynchronously. -This is a thin abstraction over the system -`url-retrieve-synchronously'. Depending on which version of this -is available we will call it with or without a timeout. -SILENT means don't message." - (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) - (url-retrieve-synchronously url) - (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) - -(defun mastodon-http--response-status (resp) - "Return the status code from RESP, a response buffer." - ;; `url-http-parse-response' breaks tests, as - ;; `url-http-end-of-headers' not set, so we roll our own: - (with-current-buffer resp - (goto-char (point-min)) - (skip-chars-forward " \t\n") ; Skip any blank crap - (skip-chars-forward "/HPT0-9.") ; Skip HTTP Version "HTTP/X.Y" - (read (current-buffer)))) - -(defun mastodon-http--triage (response success) - "Determine if RESPONSE was successful. -Call SUCCESS on RESPONSE if successful. Message status and JSON error -from RESPONSE if unsuccessful." - (let ((status (mastodon-http--response-status response))) - (if (and (>= 200 status) - (<= status 299)) - ;; (string-prefix-p "2" (number-to-string status)) - (funcall success response) - (if (= 404 status) - (message "Error %s: page not found" status) - (let ((json-response (with-current-buffer response - (mastodon-http--process-json)))) - (message "Error %s: %s" status (alist-get 'error json-response))))))) - -(defun mastodon-http--read-file-as-string (filename &optional url) - "Read a file FILENAME as a string. -Used to generate image preview. -URL means FILENAME is a URL." - (with-temp-buffer - (if url - (url-insert-file-contents filename) - (insert-file-contents filename)) - (string-to-unibyte (buffer-string)))) - -(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p) - "Make a METHOD type request using BODY, with Mastodon authorization. -Unless UNAUTHENTICATED-P is non-nil." - (declare (debug 'body) - (indent 1)) - `(let ((url-request-method ,method) - (url-request-extra-headers - (unless ,unauthenticated-p - (list (cons "Authorization" - (concat "Bearer " (mastodon-auth--access-token))))))) - ,body)) - -(defun mastodon-http--build-params-string (params) - "Build a request parameters string from parameters alist PARAMS." - ;; (url-build-query-string args nil)) - ;; url-build-query-string adds 'nil' for empty params so lets stick with our - ;; own: - (mapconcat (lambda (p) - (when (cdr p) ; only when value - (concat (url-hexify-string (car p)) - "=" (url-hexify-string (cdr p))))) - params "&")) - -(defun mastodon-http--build-array-params-alist (param-str array) - "Return parameters alist using PARAM-STR and ARRAY param values. -Used for API form data parameters that take an array." - (cl-loop for x in array - collect (cons param-str x))) - -(defun mastodon-http--concat-params-to-url (url params) - "Build a query string with PARAMS and concat to URL." - (if params - (concat url "?" - (mastodon-http--build-params-string params)) - url)) - -(defun mastodon-http--post (url - &optional params headers unauthenticated-p json) - "POST synchronously to URL, optionally with PARAMS and HEADERS. -Authorization header is included by default unless -UNAUTHENTICATED-P is non-nil. -If JSON is :json, encode PARAMS as JSON for -the request data. If it is :raw, just use the plain params." - ;; NB: raw is used by `mastodon-tl-unfilter-user-languages'; not sure if - ;; there's a way around it? - (mastodon-http--authorized-request "POST" - (let* ((url-request-data - (when params - (cond ((eq json :json) - (json-encode params)) - ((eq json :raw) - params) - (t - (mastodon-http--build-params-string params))))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - (if json - '(("Content-Type" . "application/json") - ("Accept" . "application/json")) - (unless (assoc "Content-Type" headers) ; pleroma compat: - '(("Content-Type" . "application/x-www-form-urlencoded")))) - headers))) - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))) - unauthenticated-p)) - -(defun mastodon-http--get (url &optional params silent) - "Make synchronous GET request to URL. -PARAMS is an alist of any extra parameters to send with the request. -SILENT means don't message." - (mastodon-http--authorized-request "GET" - ;; url-request-data doesn't seem to work with GET requests?: - (let ((url (mastodon-http--concat-params-to-url url params))) - (mastodon-http--url-retrieve-synchronously url silent)))) - -(defun mastodon-http--get-response (url &optional params no-headers silent vector) - "Make synchronous GET request to URL. Return JSON and response headers. -PARAMS is an alist of any extra parameters to send with the request. -SILENT means don't message. -NO-HEADERS means don't collect http response headers. -VECTOR means return json arrays as vectors." - (let ((buf (mastodon-http--get url params silent))) - ;; --get can return nil if instance unresponsive: - (if (not buf) - (user-error "Looks like the server response borked. \ -Is your instance up?") - (with-current-buffer buf - (mastodon-http--process-response no-headers vector))))) - -(defun mastodon-http--get-json (url &optional params silent vector) - "Return only JSON data from URL request. -PARAMS is an alist of any extra parameters to send with the request. -SILENT means don't message. -VECTOR means return json arrays as vectors." - (car (mastodon-http--get-response url params :no-headers silent vector))) - -(defun mastodon-http--process-json () - "Return only JSON data from async URL request. -Callback to `mastodon-http--get-json-async', usually -`mastodon-tl--init*', is run on the result." - (car (mastodon-http--process-response :no-headers))) - -(defun mastodon-http--render-html-err (string) - "Render STRING as HTML in a temp buffer. -STRING should be a HTML for a 404 errror." - (with-temp-buffer - (insert string) - (shr-render-buffer (current-buffer)) - (view-mode))) ; for 'q' to kill buffer and window - ;; (error ""))) ; stop subsequent processing - -(defun mastodon-http--process-response (&optional no-headers vector) - "Process http response. -Return a cons of JSON list and http response headers. -If NO-HEADERS is non-nil, just return the JSON. -VECTOR means return json arrays as vectors. -Callback to `mastodon-http--get-response-async', usually -`mastodon-tl--init*', is run on the result." - ;; view raw response: - ;; (switch-to-buffer (current-buffer)) - (let ((headers (unless no-headers - (mastodon-http--process-headers)))) - (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let ((json-array-type (if vector 'vector 'list)) - (json-string (string-trim-right - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8)))) - (kill-buffer) - (cond ((or (string-empty-p json-string) (null json-string)) - nil) - ;; if we get html, just render it and error: - ;; ideally we should handle the status code in here rather than - ;; this crappy hack? - ((string-prefix-p "\n<" json-string) ; html hack - ;; NB: in this case, process-response returns t!: - (mastodon-http--render-html-err json-string) - nil) ;; return nil instead of t - ;; if no json or html, maybe we have a plain string error message - ;; (misskey does this, but there are probably better ways to do - ;; this): - ((not (or (string-prefix-p "\n{" json-string) - (string-prefix-p "\n[" json-string))) - (error "%s" json-string)) - (t - ;; instance may return error in JSON e.g. ((error . "Record not - ;; found")) for a null endpoint. but we don't error here because - ;; sometimes we just want to check for such an error in an - ;; if/cond. - `(,(json-read-from-string json-string) . ,headers)))))) - -(defun mastodon-http--process-headers () - "Return an alist of http response headers." - (goto-char (point-min)) - (let* ((head-str (buffer-substring-no-properties - (point-min) - (re-search-forward "^$" nil 'move))) - (head-list (split-string head-str "\n"))) - (mapcar (lambda (x) - (let ((list (split-string x ": "))) - (cons (car list) (cadr list)))) - head-list))) - -(defun mastodon-http--delete (url &optional params) - "Make DELETE request to URL. -PARAMS is an alist of any extra parameters to send with the request." - ;; url-request-data only works with POST requests? - (let ((url (mastodon-http--concat-params-to-url url params))) - (mastodon-http--authorized-request "DELETE" - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url))))) - -(defun mastodon-http--put (url &optional params headers) - "Make PUT request to URL. -PARAMS is an alist of any extra parameters to send with the request. -HEADERS is an alist of any extra headers to send with the request." - (mastodon-http--authorized-request "PUT" - (let ((url-request-data - (when params (mastodon-http--build-params-string params))) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - (unless (assoc "Content-Type" headers) ; pleroma compat: - '(("Content-Type" . "application/x-www-form-urlencoded"))) - headers))) - (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) - -;; profile update functions - -(defun mastodon-http--patch-json (url &optional params) - "Make synchronous PATCH request to URL. Return JSON response. -Optionally specify the PARAMS to send." - (with-current-buffer (mastodon-http--patch url params) - (mastodon-http--process-json))) - -(defun mastodon-http--patch (url &optional params json) - "Make synchronous PATCH request to URL. -Optionally specify the PARAMS to send. -JSON means send params as JSON data." - (mastodon-http--authorized-request "PATCH" - ;; NB: unlike POST, PATCHing only works if we use query params! - ;; so here, unless JSON arg, we use query params and do not set - ;; `url-request-data'. this is probably an error, i don't understand it. - (let* ((url-request-data - (when (and params json) - (encode-coding-string - (json-encode params) 'utf-8))) - ;; (mastodon-http--build-params-string params)))) - (url (if (not json) - (mastodon-http--concat-params-to-url url params) - url)) - (headers (when json - '(("Content-Type" . "application/json") - ("Accept" . "application/json")))) - (url-request-extra-headers - (append url-request-extra-headers headers))) - (mastodon-http--url-retrieve-synchronously url)))) - - ;; Asynchronous functions - -(defun mastodon-http--get-async (url &optional params callback &rest cbargs) - "Make GET request to URL. -Pass response buffer to CALLBACK function with args CBARGS. -PARAMS is an alist of any extra parameters to send with the request." - (let ((url (mastodon-http--concat-params-to-url url params))) - (mastodon-http--authorized-request "GET" - (url-retrieve url callback cbargs)))) - -(defun mastodon-http--get-response-async (url &optional params callback &rest cbargs) - "Make GET request to URL. Call CALLBACK with http response and CBARGS. -PARAMS is an alist of any extra parameters to send with the request." - (mastodon-http--get-async - url - params - (lambda (status) - (when status ; for flakey servers - (apply callback (mastodon-http--process-response) cbargs))))) - -(defun mastodon-http--get-json-async (url &optional params callback &rest cbargs) - "Make GET request to URL. Call CALLBACK with json-list and CBARGS. -PARAMS is an alist of any extra parameters to send with the request." - (mastodon-http--get-async - url - params - (lambda (status) - (when status ;; only when we actually get sth? - (apply callback (mastodon-http--process-json) cbargs))))) - -(defun mastodon-http--post-async (url params _headers &optional callback &rest cbargs) - "POST asynchronously to URL with PARAMS and HEADERS. -Then run function CALLBACK with arguements CBARGS. -Authorization header is included by default unless UNAUTHENTICED-P is non-nil." - (mastodon-http--authorized-request "POST" - (let ((url-request-data (when params - (mastodon-http--build-params-string params)))) - (with-temp-buffer - (url-retrieve url callback cbargs))))) - -(defun mastodon-http--get-cb-data (status) - "Return data using `json-read' after a successful async request. -If STATUS includes an error, emit a message describing it and return nil." - (let* ((buf (current-buffer)) - (data (with-temp-buffer - (url-insert buf) - (goto-char (point-min)) - (json-read)))) - (if-let* ((error-thrown (plist-get status :error))) - ;; not necessarily a user error, but we want its functionality: - (user-error "%S %s" error-thrown (alist-get 'error data)) - data))) - -(defun mastodon-http--post-media-callback (status file caption buffer) - "Callback function called after posting FILE as an attachment with CAPTION. -The toot is being composed in BUFFER. See `url-retrieve' for STATUS." - (unwind-protect - (when-let* ((data (mastodon-http--get-cb-data status))) - (with-current-buffer buffer - (let ((id (alist-get 'id data))) - ;; update ids: - (if (not mastodon-toot--media-attachment-ids) - ;; add first id: - (push id mastodon-toot--media-attachment-ids) - ;; add new id to end of list to preserve order: - (push id (cdr - (last mastodon-toot--media-attachment-ids)))) - ;; pleroma, PUT the description: - ;; this is how the mangane akkoma web client does it - ;; and it seems easier than the other options! - (when (and caption - (not (string= caption (alist-get 'description data)))) - (let ((url (mastodon-http--api (format "media/%s" id)))) - ;; (message "PUTting image description") - (mastodon-http--put url `(("description" . ,caption))))) - (message "Uploading %s... (done)" file) - (mastodon-toot--update-status-fields)))) - (kill-buffer (current-buffer)))) - -(defun mastodon-http--post-media-prep-file (filename) - "Return the request data to upload FILENAME." - (with-temp-buffer - (set-buffer-multibyte nil) - (insert-file-contents-literally filename) - (let ((boundary (buffer-hash))) - (goto-char (point-min)) - (insert "--" boundary "\r\n" - (format "Content-Disposition: form-data; name=\"file\"; filename=\"%s\"\r\n\r\n" - (file-name-nondirectory filename))) - (goto-char (point-max)) - (insert "\r\n" "--" boundary "--" "\r\n") - `(,boundary . ,(buffer-substring-no-properties (point-min) (point-max)))))) - -(defun mastodon-http--post-media-attachment (url filename caption) - "Make POST request to upload FILENAME with CAPTION to the server's media URL. -The upload is asynchronous. On succeeding, -`mastodon-toot--media-attachment-ids' is set to the id(s) of the -item uploaded, and `mastodon-toot--update-status-fields' is run." - (mastodon-http--authorized-request "POST" - (let* ((data (mastodon-http--post-media-prep-file filename)) - (url-request-extra-headers - (append url-request-extra-headers ; auth set in macro - `(("Content-Type" . ,(format "multipart/form-data; boundary=%s" - (car data)))))) - (url-request-data (cdr data)) - (params `(("description" . ,caption))) - (url (mastodon-http--concat-params-to-url url params))) - (url-retrieve url #'mastodon-http--post-media-callback - `(,filename ,caption ,(current-buffer)))))) - -(provide 'mastodon-http) -;;; mastodon-http.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-inspect.el b/elpa/mastodon-20251201.1553/mastodon-inspect.el deleted file mode 100644 index 4981943f..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-inspect.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; mastodon-inspect.el --- Client for Mastodon -*- lexical-binding: t -*- - -;; Copyright (C) 2017-2019 Johnson Denen -;; Copyright (C) 2020-2024 Marty Hiatt -;; Author: Johnson Denen -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; 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 diff --git a/elpa/mastodon-20251201.1553/mastodon-iso.el b/elpa/mastodon-20251201.1553/mastodon-iso.el deleted file mode 100644 index 6199cbe0..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-iso.el +++ /dev/null @@ -1,244 +0,0 @@ -;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*- - -;; Copyright (C) 2022 Marty Hiatt -;; Author: Marty Hiatt -;; 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 . - -;;; 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 diff --git a/elpa/mastodon-20251201.1553/mastodon-media.el b/elpa/mastodon-20251201.1553/mastodon-media.el deleted file mode 100644 index 0e3c24a2..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-media.el +++ /dev/null @@ -1,534 +0,0 @@ -;;; 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 -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-media.el provides functions for inlining media. - -;; Known bug gnutls -12 when trying to access images on some systems. -;; It looks like their may be a version mismatch between the encryption -;; required by the server and client. - -;;; Code: -(require 'url-cache) -(require 'mm-decode) -(require 'image-mode) - -(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") -(autoload 'mastodon-tl--image-trans-check "mastodon-tl") -(autoload 'mastodon-image-mode "mastodon-tl") - -(defvar url-show-status) - -(defvar mastodon-tl--shr-image-map-replacement) - -(defgroup mastodon-media nil - "Inline Mastadon media." - :prefix "mastodon-media-" - :group 'mastodon) - -(defcustom mastodon-media--avatar-height 20 - "Height of the user avatar images (if shown)." - :type 'integer) - -(defcustom mastodon-media--preview-max-height 250 - "Max height of any media attachment preview to be shown in timelines." - :type 'integer) - -(defcustom mastodon-media--enable-image-caching nil - "Whether images should be cached." - :type 'boolean) - -(defcustom mastodon-media--hide-sensitive-media t - "Whether media marked as sensitive should be hidden." - :type 'boolean) - -(defvar mastodon-media--generic-avatar-data - (base64-decode-string - "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA -B3RJTUUH4QUIFCg2lVD1hwAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAcGSURB -VHja7dzdT1J/HAfwcw7EQzMKW0pGRMK4qdRZbdrs6aIRbt506V1b/AV1U2td9l9UXnmhW6vgwuko -SbcOD/a0RB4CCRCRg0AIR4Hz8LvgN2cKCMI5wOH7uXBuugO+eH8+fM/3HIFpmoZAVVYIIABYAAtg -ASyABbAAAcACWAALYAEsgAUIABbAAlgAC2ABLEAAsAAWwAJYAAtgAQKAxUjxm+R50DRN0zRFUf+8 -kggCwzAMwwDrfyOSJGmattlsdrvd5XLlcrndnyoUir6+vpGRkZMnT/J4vIarwY26MaTAZLVap6en -fT7f9vY2QRA7Ozv/vJJ8vkgk4vP5XV1dWq1Wq9VKpdIGkjUGi6IoFEWnp6ddLlcymSRJsvzv83g8 -kUikUCi0Wq1Opzt16lS7YBEE8ebNG6PRiGHYoUwHyW7cuPHo0SOlUsl9LIIgXrx4Ybfb//79e7Qj -CIXC3t7ex48fX7lyhctYBSkURTOZTC3H4fF4SqXy6dOnLHuxh0VR1PPnz2uX2uv17Nmzy5cvc21R -StP0q1ev7HZ7XaQgCCJJ0u/3T0xMBINBrmGhKGo0Go88p0p5Wa1Wg8GQSqW4g0XT9NTUFIZhdT9y -Npudn59nLVwIO7FyuVxVrRIqr1AoZDab2QkXG1hTU1PJZJKhg5MkOT8/HwqFuIBF07TP52MoVrvh -YqLHG4BlsVi2t7cZfQiSJB0OBwudyDiWzWYjCILpR1lZWeECltPp3LeXwEQFg8FoNNryWPl8noVp -ws6jgG1lgAWwuI914cIFPp/xnX6ZTCYSiVoeq7+/n4U/Q61Wy+Xylse6desWC8kaGBiQSCQtjyWR -SGQyGY/HY+4hpFJpV1cXRwa8TqdjtBOHh4fVajVHsLRarVKpZChcUqn07t27LPQgS1gSiUSn04nF -4rofGYbh4eHhgYEBTq2ztFrtyMhI3ZtRo9GMjY2xEyv2sCQSiV6vV6lUdWzGzs7O8fHxwcFBDq7g -5XL5kydPent76+LV2dmp1+vv37/P5gqe7SvSDofj5cuXteydwjAslUr1ev2DBw9YPt1pwL0ODodj -YmLCYrEcYZ8LhmGNRjM+Ps5yphqGBUFQKBQyGo0mk2l1dTWfz5MkSVFUPp8/+GSEQiEMw8eOHYNh -uLu7e2hoaGxsjM05tbfYvpkNx/FQKBSJRCAI6unpwTBsbW0tmUwWbtc6mCMEQSAIOn78+Llz586f -P9/T05PL5QKBgEKh4GyyCkZfvnwJhULhcHhzczOTyRRuYMtms/l8PpPJZDKZnZ2dvc9HIBCIxeIT -J04Uvil87ejoOH36tEwm02g0V69evXjxIkewCkZer/fr16+/f/+OxWKlrvQQBEEQxL7dYQRBhEJh -0fNwBEHEYrFMJlOpVP39/RqNhgU1prAKTDMzMy6XKxqNJhIJptY+CHLmzBmZTHbp0qXbt2+rVKpW -wtplWl5eDofDTF803Bs0tVrNKFmdsXAcn52dnZ2dDQaD7DAVJRsdHb1z507dT93rhoXj+MrKytzc -3NLSEnNNVyHZ2bNnr127NjQ0NDg4WEey+mDhOP7u3bu5ubkyI5z9iMnl8nv37o2OjgoEgmbBisVi -r1+/ttlsjQ1UmYg9fPiwo6OjwVg4jn///v3Dhw/Ly8vNEKiiXhKJpK+vT6fT1d6S/FqkUBSdnJz0 -+/1QsxZFUclkEkXReDxOkuT169dr8TpisnAcN5lMb9++ZfP+11pKIBAUdgpv3rx55BGGtIMUBEG5 -XM7tdhsMhoWFhb3/S8UsVitK1curaqzV1dX379+3nNQ+r42NjSPsPlaH5fP5mnyiV+Ll9XonJyfD -4XC1XkhVDTgzM/Pz50+oxSubzX779u3z58/VLneQyqUMBsOnT5+acz1V7XoiHo9//PjRZDKl0+n6 -Y3k8HrPZ3Gxr9Fq81tfXl5aWAoFA5cO+IqxIJFLYSIA4VARBuN3uxcXFyoc9v5IGNJvNVquVAw14 -sBktFkt3d7dUKq3k5BGpJFYLCwucacCizZhIJCoJF3JorBYXF//8+QNxtAiCKFwiqKRvkEPnOoqi -HGvAfeFKJBIVTnqkfKx+/PjBsbleKlwej6cmLI/H43A4OByr3XClUimn03louMphra2teb1eqA0q -m836fL6tra0jYkUiEb/fz8k3waLhikQiXq+3/NtiSayNjY1fv35BbVP5fN7pdG5tbR0Fy+12c360 -Hxzz5a8KI6V6EMMwzo/2fZ2YTqej0WgqlSoVLqRUDwYCAajNiqKoYDBYphOLY8ViscItVG1VJEmu -r6+XeU8sjhWPxzc3N9sNiyAIDMOqS1YbDqwKx1YRrFQqxc7HJDRnpdPpUuEqgoVhWL0+i6hFz6tL -ja3iM4u1zw1qwhlfJihI0bfCNhxYe4NSqg3/A862hQAbrdtHAAAAAElFTkSuQmCC") - "The PNG data for a generic 100x100 avatar.") - -(defvar mastodon-media--generic-broken-image-data - (base64-decode-string - "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA -B3RJTUUH4QUIFQUVFt+0LQAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAdoSURB -VHja7d1NSFRrAIfx//iB6ZDSMJYVkWEk0ceYFUkkhhQlEUhEg0FlC1eBoRTUwlbRok0TgRQURZAE -FgpjJmFajpK4kggxpXHRQEGWUJZizpy7uPfC5eKiV+dD5zw/mN05jrxnnjnfcxyWZVkCMKc0SXI4 -HIwEMIcUhgAgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCAAgQAEAhAIQCAAgQA2kBaNP8Jt7ViM -onErOWsQgEAAAgEIBCAQgEAAAgEIBCAQgEAAEAhAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAA -AgEIBCAQgEAAAgEIBACBAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgECAxSyNIYitz58/ -a3BwUIODgxoZGVEoFFIoFNK3b980NTWlX79+SZIyMzOVlZWlVatWae3atSooKJDH49HOnTvl8XiU -ksJ3WSI4LMuyHA7Hgv6IZVmM5D8mJyf1/PlzdXZ2qrOzU8FgcMF/0+126+DBg6qqqlJFRYXS0vhe -+6MP9wI/1wQSJeFwWH6/X01NTWpra9PU1FTM3isvL0/nz5/XuXPntHz5ciqIcSCy/v50L+hlV+Pj -49a1a9esdevWLXgMTV8ul8u6c+eOFYlELMwtKmNNIOa+fv1qXbp0yXI6nXEP4/+v0tJS6+PHj9RA -IIk3PT1tXb161crOzk54GP995ebmWt3d3RRBIInj9/utgoKCRRXGf18ZGRmW3++niigHwk56PHf4 -Yiw9PV0dHR0qLy9nD52jWAQylxUrVmhgYEAbN24kkCgsM84+JZmJiQmdPn1akUiEweBE4eL/NsrN -zVVZWZlKSkpUWFioTZs2yeVyKTs7W7Ozs5qYmNDExITev3+v/v5+9fX1qb+/f8FjevPmTdXW1rIG -IZDFN9gbNmyQ1+uV1+uVx+MxXlAjIyNqbGzU3bt39fPnz3n9vytXrlQwGJTT6SQQThQm/ohIamqq -VVlZaXV1dUXtPT98+GCVlZXNe7n4fD6OYnGYN7GDnZ6ebtXU1FhjY2Mxed9IJGLV19fPa7kUFRUR -CIEkZrAdDod15syZmIXxf7W1tfNaNqOjowSygBdHseZh7969GhgY0IMHD5Sfnx+X97xx44Z2795t -PF93dzcLjMO88TvHcP/+ffX19WnXrl3xXVApKbp9+7bxfSFv3rxhwRFI7B07dkxDQ0Oqrq5O2P9Q -XFysffv2Gc0zOjrKwiOQ2Hv69Kny8vIS/n8cP37caPqxsTEWHoHYa//HxPfv3xk0ArGP1atXG03/ -7z3vIBBbyM3NNZo+KyuLQSMQ+5icnDSaPicnh0EjEPsYHh42mp7L3gnEVnp6eoymLyoqYtAIxD4e -PXpkNP3+/fsZtAXgcvclpL29XUeOHPnj6Z1Op8bHx7Vs2TJ7fri5o9A+ZmZmdPHiRaN5vF6vbeNg -E8tmGhoaNDQ0ZPTteeHCBQaOQJLfkydPdP36daN5Tp48qc2bNzN47IMkt9evX+vw4cOanp7+43ly -cnI0PDy8KK4dYx8EMRMIBHT06FGjOCTJ5/PZPg42sZJce3u7Dh06pB8/fhjNV11dndBL8tnEYhMr -5lpaWuT1evX792+j+YqLixUIBLj+ik2s5NXc3KwTJ04Yx5Gfn69nz54RB5tYyaupqUlVVVWanZ01 -ms/tdqujo4P9DgJJXg8fPtSpU6cUDoeN43j58qUKCwsZRAJJTvfu3dPZs2eNf0/X7Xarq6tL27dv -ZxAJJDn5fD7V1NQYx7FmzRq9evVK27ZtYxAJJDk1NDSorq7O+ChgQUGBent7tWXLFgYxxniecILU -1dXJ5/MZz7d161a9ePHC+N50sAZZMq5cuTKvOEpKStTT00McccSJwji7devWvJ7bceDAAbW2ttr6 -cQbGH26eD7K0BAIBlZeXG5/nqKioUEtLizIyMhhEAklOX758kcfj0adPn4zXHG1tbcSRoEDYB4mT -y5cvG8exZ88etba2Egf7IMnt7du32rFjh9G5jvz8fA0MDBj/UBxYgyw5jY2NRnGkpqaqubmZOBYB -AomxmZkZPX782Gie+vr6uD9/BGxiJURvb69KS0v/ePrMzEyFQiG5XC4Gj02s5BcIBIymr6ysJA42 -sezj3bt3RtObPv8DBLKkBYNBo+m5r4NAbCUUChlNv379egaNQOzD9FdJ2P8gEFsxfQQaFyMuLhzm -jfUAG45tOBw2fhY6ojP2rEGWwiqdONjEAggEIBCAQAACAUAgAIEA0cIPx8UYJ1FZgwAEAhAIAAIB -CAQgEIBAAAIBFiNOFMaY6V1tnFhkDQIQCEAgAIEABAKAQAACAQgEIBCAQAACAQgEIBCAQABIXO4e -c1y+zhoEIBCAQAAQCEAgAIEABAIQCEAgAIEABAIQCEAgAAgEIBCAQAACAQgEIBCAQAACAQgEAIEA -BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA -fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") - "The PNG data for a generic 200x200 \"broken image\" view.") - -(defvar mastodon-media--sensitive-image-data - (base64-decode-string - "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAA6npUWHRSYXcgcHJvZmlsZSB0eXBl -IGV4aWYAAHjajVHbjcQwCPx3FVcCr/hRjvOSroMtfyc2Ts4rrXRIxjAQPEzC8fo9w89lkiXYknIs -MRLMihWpCDJ1W5tnsuabbaPGMx7uggBS3NrTIo4fwBGz58X7efSPQSPgimh5CrU6vs746gMlfw5y -Bsr9Zdr9Ax+k4oxsXi2WnKbV9o1my88xTRKXyMngTSilWBBnIUvQc7+InpuUNmjpgt7AyEergJMc -ykrwqtZZ6nVMK+7YvAU0skMMb9qFJ/xKUADz4g9VusX8q82j0Rf7z1rhDfqGdxgpcULlAAABhWlD -Q1BJQ0MgcHJvZmlsZQAAeJx9kT1Iw0AcxV8/tKJVBzuIOGSoTnZREd1qFYpQIdQKrTqYXPohNGlI -UlwcBdeCgx+LVQcXZ10dXAVB8APE2cFJ0UVK/F9SaBHjwXE/3t173L0D/PUyU81gHFA1y0gnE0I2 -tyKEXtGJIHowgz6JmfqsKKbgOb7u4ePrXYxneZ/7c/QqeZMBPoE4znTDIl4nntq0dM77xBFWkhTi -c+Ixgy5I/Mh12eU3zkWH/TwzYmTSc8QRYqHYxnIbs5KhEk8SRxVVo3x/1mWF8xZntVxlzXvyF4bz -2vIS12kOI4kFLEKEABlVbKAMCzFaNVJMpGk/4eEfcvwiuWRybYCRYx4VqJAcP/gf/O7WLEyMu0nh -BNDxYtsfI0BoF2jUbPv72LYbJ0DgGbjSWv5KHZj+JL3W0qJHQP82cHHd0uQ94HIHGHzSJUNypABN -f6EAvJ/RN+WAgVuge9XtrbmP0wcgQ12lboCDQ2C0SNlrHu/uau/t3zPN/n4Ag31yra/8+kkAAA14 -aVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8P3hwYWNrZXQgYmVnaW49Iu+7vyIgaWQ9Ilc1TTBN -cENlaGlIenJlU3pOVGN6a2M5ZCI/Pgo8eDp4bXBtZXRhIHhtbG5zOng9ImFkb2JlOm5zOm1ldGEv -IiB4OnhtcHRrPSJYTVAgQ29yZSA0LjQuMC1FeGl2MiI+CiA8cmRmOlJERiB4bWxuczpyZGY9Imh0 -dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogIDxyZGY6RGVzY3Jp -cHRpb24gcmRmOmFib3V0PSIiCiAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94 -YXAvMS4wL21tLyIKICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv -c1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2Vs -ZW1lbnRzLzEuMS8iCiAgICB4bWxuczpHSU1QPSJodHRwOi8vd3d3LmdpbXAub3JnL3htcC8iCiAg -ICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht -cD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgeG1wTU06RG9jdW1lbnRJRD0iZ2lt -cDpkb2NpZDpnaW1wOmYyYjU4MzUwLTc3ZWMtNDAxNC1hNDVlLTE1N2QyZjljOGM5NyIKICAgeG1w -TU06SW5zdGFuY2VJRD0ieG1wLmlpZDowOTk5MzZhMi1jOGM5LTRkYTAtYTI0Yi02YTM1MmUyNmNi -NmUiCiAgIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDphMDliYmZhMi03MzA2LTQ3 -NWQtOGExNC05YzA3ZTE1NmFiMTYiCiAgIGRjOkZvcm1hdD0iaW1hZ2UvcG5nIgogICBHSU1QOkFQ -ST0iMi4wIgogICBHSU1QOlBsYXRmb3JtPSJMaW51eCIKICAgR0lNUDpUaW1lU3RhbXA9IjE3MTc1 -MDI1MDIzNDQ1NzIiCiAgIEdJTVA6VmVyc2lvbj0iMi4xMC4zNCIKICAgdGlmZjpPcmllbnRhdGlv -bj0iMSIKICAgeG1wOkNyZWF0b3JUb29sPSJHSU1QIDIuMTAiCiAgIHhtcDpNZXRhZGF0YURhdGU9 -IjIwMjQ6MDY6MDRUMTQ6MDE6NDArMDI6MDAiCiAgIHhtcDpNb2RpZnlEYXRlPSIyMDI0OjA2OjA0 -VDE0OjAxOjQwKzAyOjAwIj4KICAgPHhtcE1NOkhpc3Rvcnk+CiAgICA8cmRmOlNlcT4KICAgICA8 -cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0ic2F2ZWQiCiAgICAgIHN0RXZ0OmNoYW5nZWQ9Ii8i -CiAgICAgIHN0RXZ0Omluc3RhbmNlSUQ9InhtcC5paWQ6NTRmM2I5NDktOTlkMS00Mzk2LWI2NzIt -Y2ZkYjRlZWFiYTA1IgogICAgICBzdEV2dDpzb2Z0d2FyZUFnZW50PSJHaW1wIDIuMTAgKExpbnV4 -KSIKICAgICAgc3RFdnQ6d2hlbj0iMjAyNC0wNi0wNFQxNDowMTo0MiswMjowMCIvPgogICAgPC9y -ZGY6U2VxPgogICA8L3htcE1NOkhpc3Rvcnk+CiAgPC9yZGY6RGVzY3JpcHRpb24+CiA8L3JkZjpS -REY+CjwveDp4bXBtZXRhPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg -ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAg -ICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6w3d0DAAAABmJLR0QA/wD/AP+gvaeTAAAA -CXBIWXMAAC4jAAAuIwF4pT92AAAAB3RJTUUH6AYEDAEq/VtQSwAAABl0RVh0Q29tbWVudABDcmVh -dGVkIHdpdGggR0lNUFeBDhcAAAtOSURBVHja7dvbT5R3Hsfxz5xwhtOsjkgFGQZRTlFOCjJSkpVe -YFltmpZNuo3t9qLdu/4Pa/+L3jVZL9pEU2q7aGirEkUkWw+IM5SpOELxgICcUXjmsBfKBOooo2Za -3H2/Ei+EeRif74/3c5gnmj47fDgqAHGZGQFAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEI -BCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgEAAAgEIBCAQgEAAAgFA -IACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEIBCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAjw -CrIm+w0ikYiCwaB8Pp8GBweVk5OjoqIiOZ1OjY+Pq6qq6g8fwuLiov7d1qbFhQUdOHhQaampSd0O -BBLT2dmp8+fP6/3331dzc7Oi0ahu3bql1tZW7dixY00MIRqNKhQKyWyxyPQ7bAcCkSSNjY3p7Nmz -anzjDeXl5cW+7vF41NLSos7OzjUxhHXr1umvLS2/23bgHkSSNDk5+ahC65Md5uTkaMuyaID/u0BS -UlIkSd0XLmhubu6J73vr6tb8gO7fv69gMMhvyhqfV7LeN6mBZGdnKysrS1NTU2r95htNTU29Uou9 -uLiojo4OhUIhfvPX8LyS+b6mzw4fjibzHz8+Pq6jx45pfGxMqamp+suBA9pWWCiTKf5tbSgU0vXr -1+X3+3Xnzh1t2bJFFRUV8ng8kqSBgQF99dVXkiTXxo36xyefaGBgQD6/X0ODg8rNzVVdXZ1ycnJW -DNDn86nv55/1YH5excXF8nq9slgsikajmpiY0PDwsPx+v5qbm5WZmamJiQmdOHlSN4NB2Ww2paWn -a252Vk1NTSovL3/qdsePH1dfX5/WrVsnm82mSCSiAwcOqKCgQF1dXeru7pbNZpNhGCoqKlJzc3NC -+53oJW0gEND1gQGNjY4qNzdXZWVlKikpic07EolocHBQgUBAwWBQVqtVnoICFW3frry8vNjrnnfO -q80rWeub6Pu+KMu+ffv+mcxAUlNTVVxUpLm5Od2+fVt+n0/z8/PavHlz7BJsiWEYOnXqlDwej6qr -q1VVVaUHDx+qtbVVm7KztdHlktPp1I4dOxQIBDQ5OSmTySSXy6Vd1dWqrKxU8OZNnTl9Wrt27Yrd -+5w5c0YOh0NvNDYqPz9f7e3tqq6ultVq1YMHD+T3+3X+/HmNjIyourpaDodDDodDmzZt0uXLl/XO -O+9o//79qq+vV3Z2tiQ9dbvCwkLl5ubqypUrcjqd+vjjj+VyuSRJW7ZsUVlZmX755Rft3r1bDQ0N -MpvNCe33avoDAXV0dKi2pkY1u3erpLRU83Nz8vv9Ki4ultVq1eLiotrb2zU8PKz6+nrt3btXZWVl -j87wra0yDENut1tms/m557zavJK1vom875q9xFqSkZGhgwcP6t1335XdbtelS5f0xRdf6N69eyte -19PTo/T0dL322muyWCxKSUlRdVWVcnJzdaKtTXNzc7JYLHK5XMrKypLNZtOePXvkdrtjw6qsqJBh -GLo3Oho7e3R3dys9I0MWi0UbN25UQ0ODotFoLOC6ujo1NDQ8eXp9fDQ1m81xw4+3ndVqVWFhocrL -y3Xv3r0V914mk0l2u102m01VVVWyWCwJ7/ezDA0N6djRo3pz/365XC6ZzWb9yenU66+/rg8++EB2 -u12SdOHCBQUCATU1NWnDhg2yWCxKTU1VbW2tGhsb1d3drf/89NOjI+dzznm1eSVrfRN53zX7Me+K -Es1mFRcXKycnR6dOnZLP59OXX36pjz76SJmZmVpYWNCPP/6ocDisjo6OuD/jRjConY+fnVgsltiQ -l3M4HLEj/NLrsrOz9e3x42ppaZHb7Y77cNJifbFRPG276upqXb16VYFAQLW1tbGvDwwMaE9dXezs -9rz7/VuRSEQ//PCDamtrtWHDhqf+O2dmZnTu3DnVeb1KS0t74vuVlZU6e/asTp86pfKdO2OvSXTO -q0nW+ibb7xbI8rNJc3OzZDLJd+2aenp61NDQoKmpKYXDYR06dEhut1vRaDR2lF86SjztviXeUT8S -DscG/fbbb+vosWM6cuSIvF6v9uzZo9QkP/XevHmztm/fro6ODu0sL5fDblcoFNJPFy/qb++9F3vd -y+735OSk7t69q5plEcaz9AFJZkZG3O/b7Xbt2LlTly9d0vT0dNyInjXn1SRrfV/pj3mnp6cViUSe -+LrNZtNer1eS1HvtWuz6dPkATCaTzGZz7E8iw5MUG/ryZy8ul0t///BD7WtsVFdXl/515IhmZmaS -OliTyaSamhoZhqEbAwOxS6GqykrZbLYV1+Uvs98PHz58tJAJzmd2dvbpB6/09IT3L96cnyWZ6/vK -BjI4NPTEfcaStMeLsbQo6x5fJ48uu7Z8EeHHR5blv4ThcFh2u13eujodOnRI42Njunr1asI/MxJ9 -sQ/68vLylJObq3OdnVpcXNTFixe1bdu2Fa952f1eugQZGxt75uucTuejA1Jvb+yXNd6zBEnKzMx8 -oTk/a17JXN+XXac/LJBUh0NdXV1xP58ef7ygFRUVkqQN69fLnZ+vzs7OuEe5Bw8famJiYsXfw3FO -s4uLiyuOMAsLC7p0+XLs+263W6VlZU9su3SmW37aX7qJfjA/v+KsuPw18bZbvv1er1fjY2P6/vvv -lZ+fH7uGXvK8+/1b69ev1+acHHV2dsZ9znT37l3Nzs4qIyND9fX1mpmZkc/ni3updu3aNf15374V -l1eJznm1eSVrfRNdpzUZSHp6uvr6+vTtd99pZGREoVBIhmFoeHhYJ0+eVEVFhUpLS2M38fubmhQO -h/XN8eMaGRlROBxWKBTSnTt3dDMYjB0FZ2ZmNPzrrzIMY8WlkmEYGhwcjIURjUZltVp15vRp3b59 -W5FIRGNjYxq8eVNFRUUrbiBHRkZig10KOjMzU66NG+Xz+zU/P6/Z2Vn19vauut1yHo9HTqdTPT09 -KikpifvhRaL7HfdDAotFb+7fL5vNphMnTmh0dFSRSESGYSgYDOr+/ftKf3yW9nq9qqysVFtbm65c -uRL7JRwdHVXbiRPaXVOj2pqaFTf2ic55tXkla30TWac1+6BwYWFBP/f3y5mZqVu3bmngxg3NTE/L -4/GoqLhYWwsKYvUvL7+3t1d9fX2ypaRoa0GBSkpKlJWVJUnq6+vT119/vWKbt956S263W59//nns -5xmGIYfDoU8//VTt7e1KS0tTf3+/srKytGvXLuXm5kqSgsGg2tralJKSonA4LMMw5PF4dPDgwUeX -LuPjOt/ZqZGREe0sL1d1VZVSUlJW3W45n9+vyYkJ1dfXP/N+7Vn7vZqJiQn19vaqv79fZrNZhYWF -Ki0tfeJ5QCQS0dDQkAKBgG7cuCFJ2rp1q4qKimLPQF50ziaT6anzSub6JvK+a/ZJejIsfQKy/IYP -/ztzXkvra30VFy7RjwTxas55La0v/+UWIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQ -CEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCA -QAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCA -QAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEA -BAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAQgEAIEABAIQCEAgAIEABAIQCEAgAIEA -IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==") - "The PNG data for a sensitive image placeholder.") - -(defun mastodon-media--process-image-response - (status-plist url marker image-options region-length) - "Callback function processing the url retrieve response for URL. -STATUS-PLIST is the usual plist of status events as per `url-retrieve'. -IMAGE-OPTIONS are the precomputed options to apply to the image. -MARKER is the marker to where the response should be visible. -REGION-LENGTH is the length of the region that should be replaced -with the image." - (when (marker-buffer marker) ; if buffer hasn't been killed - (let ((url-buffer (current-buffer)) - (is-error-response-p (eq :error (car status-plist)))) - (let* ((data (unless is-error-response-p - (goto-char (point-min)) - (and (search-forward "\n\n" nil t) - (buffer-substring (point) (point-max))))) - (image (when data - (apply #'create-image data ;; inbuilt scaling in 27.1: - (when (version< emacs-version "27.1") - (when image-options 'imagemagick)) - t image-options)))) - (when mastodon-media--enable-image-caching - (unless (url-is-cached url) ; cache if not already cached - (url-store-in-cache url-buffer))) - (with-current-buffer (marker-buffer marker) - ;; Save narrowing in our buffer - (let ((inhibit-read-only t)) - (save-restriction - (widen) - (put-text-property marker - (+ marker region-length) 'media-state 'loaded) - (when image - ;; We only set the image to display if we could load - ;; it; we already have set a default image when we - ;; added the tag. - (mastodon-media--display-image-or-sensitive - marker region-length image)) - ;; We are done with the marker; release it: - (set-marker marker nil))) - (kill-buffer url-buffer)))))) - -(defun mastodon-media--display-image-or-sensitive (marker region-length image) - "Display image using display property, or add sensitive mask. -MARKER, REGION-LENGTH and IMAGE are from -`mastodon-media--process-image-response'. -If the image is marked sensitive, the image is stored in -image-data prop so it can be toggled." - (if (or (not (eq t (get-text-property marker 'sensitive))) - (not mastodon-media--hide-sensitive-media)) - ;; display image - (put-text-property marker (+ marker region-length) - 'display image) - ;; display sensitive placeholder and save image data as prop: - (add-text-properties marker (+ marker region-length) - `(display - ;; (image :type png :data ,mastodon-media--sensitive-image-data) - ,(create-image - mastodon-media--sensitive-image-data nil t) - sensitive-state hidden image-data ,image)))) - -(defvar mastodon-media--attachments nil - "A list attachment details for full sized image view buffer. -The first element is the URL of the image displayed, followed by plists -of details of all of a toot's attachments.") - -(defun mastodon-media--process-full-sized-image-response - (status-plist url attachments &optional prev-buf) - ;; FIXME: refactor this with but not into - ;; `mastodon-media--process-image-response'. - "Callback function processing the `url-retrieve' response for URL. -URL is a full-sized image URL attached to a timeline image. -STATUS-PLIST is a plist of status events as per `url-retrieve'." - (if-let* ((error-response (plist-get status-plist :error))) - (user-error "error in loading image: %S" error-response) - (when mastodon-media--enable-image-caching - (unless (url-is-cached url) ;; cache if not already cached - (url-store-in-cache))) - ;; thanks to rahguzar for this idea: - ;; https://codeberg.org/martianh/mastodon.el/issues/540 - (let* ((handle (mm-dissect-buffer t)) - (image (mm-get-image handle)) - (str (image-property image :data)) - (buf "*masto-image*")) - (with-current-buffer (get-buffer-create buf) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert-image image str) - (special-mode) ; prevent image-mode loop bug - (mastodon-image-mode) ;; for our keymap - (goto-char (point-min)) - (image-transform-fit-both) - ;; set image metadata for view cycling: - (setq-local mastodon-media--attachments (cons url attachments)))) - ;; switch to buf if not already viewing it: - (unless (equal buf prev-buf) - (switch-to-buffer-other-window buf)) - ;; display bindings if multiple images: - (when (< 1 (length (cdr mastodon-media--attachments))) - (message (substitute-command-keys - "\\`.'/\\`>'/\\`' to cycle images")))))) - -(defun mastodon-media--image-or-cached (url process-fun args) - "Fetch URL from cache or fro host. -Call PROCESS-FUN on it with ARGS, a list of callback args as -specified by `url-retrieve'." - (if (and mastodon-media--enable-image-caching - (url-is-cached url)) ;; if cached, decompress and use: - (with-current-buffer (url-fetch-from-cache url) - (set-buffer-multibyte nil) - (goto-char (point-min)) - (zlib-decompress-region - (goto-char (search-forward "\n\n")) (point-max)) - (apply process-fun args)) ;; no status-plist arg from cache - ;; fetch as usual and process-image-response will cache it: - ;; cbargs fun will be called with status-plist by url-retrieve: - (url-retrieve url process-fun (cdr args)))) - -(defun mastodon-media--load-image-from-url (url media-type start region-length) - "Take a URL and MEDIA-TYPE and load the image asynchronously. -MEDIA-TYPE is a symbol and either `avatar' or `media-link'. -START is the position where we start loading the image. -REGION-LENGTH is the range from start to propertize." - (let ((image-options - (when (mastodon-tl--image-trans-check) - (cond ((eq media-type 'avatar) - `(:height ,mastodon-media--avatar-height)) - ((eq media-type 'media-link) - `(:max-height ,mastodon-media--preview-max-height))))) - (buffer (current-buffer)) - (marker (copy-marker start)) - (url-show-status nil)) ; stop url.el from spamming us about connecting - (condition-case nil - ;; catch errors in url-retrieve to not break our caller - (mastodon-media--image-or-cached - url - #'mastodon-media--process-image-response - (list nil url marker image-options region-length)) - (error (with-current-buffer buffer - ;; TODO: Add retries - (put-text-property marker (+ marker region-length) - 'media-state 'loading-failed) - :loading-failed))))) - -(defun mastodon-media--select-next-media-line (end-pos) - "Find coordinates of the next media to load before END-POS. -Returns the list of (`start' . `end', `media-symbol') points of -that line and string found or nil no more media links were -found." - (let ((next-pos (point))) - (while - (and - (setq next-pos (next-single-property-change next-pos 'media-state)) - (or (not (eq 'needs-loading (get-text-property next-pos 'media-state))) - (null (get-text-property next-pos 'media-url)) - (null (get-text-property next-pos 'media-type)))) - ;; do nothing - the loop will proceed - ) - (when (and next-pos (< next-pos end-pos)) - (let ((media-type (get-text-property next-pos 'media-type))) - (cond - ((eq media-type 'avatar) ; avatars are one character - (list next-pos (+ next-pos 1) 'avatar)) - ((eq media-type 'media-link) ; media links are 5 characters: [img] - (list next-pos (+ next-pos 5) 'media-link))))))) - -(defun mastodon-media--valid-link-p (link) - "Check if LINK is valid. -Checks to make sure the missing string has not been returned." - (and link - (> (length link) 8) - (or (string= "http://" (substring link 0 7)) - (string= "https://" (substring link 0 8))))) - -(defun mastodon-media--inline-images (search-start search-end) - "Find all `Media_Links:' in the range from SEARCH-START to SEARCH-END. -Replace them with the referenced image." - (save-excursion - (goto-char search-start) - (let (line-details) - (while (setq line-details - (mastodon-media--select-next-media-line search-end)) - (let* ((start (car line-details)) - (end (cadr line-details)) - (media-type (cadr (cdr line-details))) - (type (get-text-property start 'mastodon-media-type)) - (image-url (get-text-property start 'media-url))) - (if (not (mastodon-media--valid-link-p image-url)) - ;; mark it at least as not needing loading any more - (put-text-property start end 'media-state 'invalid-url) - ;; proceed to load this image asynchronously - (put-text-property start end 'media-state 'loading) - (mastodon-media--load-image-from-url - image-url media-type start (- end start)) - (when (or (string= type "gifv") - (string= type "video")) - (mastodon-media--moving-image-overlay start end)))))))) - -;; (defvar-local mastodon-media--overlays nil -;; "Holds a list of overlays in the buffer.") - -(defun mastodon-media--moving-image-overlay (start end) - "Add play symbol overlay to moving image media items. -START and END are the beginning and end of the media item to overlay." - (let ((ov (make-overlay start end))) - (overlay-put - ov - 'after-string - (propertize "" - 'help-echo "Video" - 'face - '((:height 3.5 :inherit mastodon-toot-docs-face)))))) -;; (cl-pushnew ov mastodon-media--overlays))) - -(defun mastodon-media--get-avatar-rendering (avatar-url) - "Return the string to be written that renders the avatar at AVATAR-URL." - ;; We use just an empty space as the textual representation. - ;; This is what a user will see on a non-graphical display - ;; where not showing an avatar at all is preferable. - (let ((image-options (when (mastodon-tl--image-trans-check) - `(:height ,mastodon-media--avatar-height)))) - (concat - (propertize " " - 'media-url avatar-url - 'media-state 'needs-loading - 'media-type 'avatar - 'display - (apply #'create-image mastodon-media--generic-avatar-data - ;; inbuilt scaling in 27.1 - (when (version< emacs-version "27.1") - (when image-options 'imagemagick)) - t image-options)) - " "))) - -(defun mastodon-media--get-media-link-rendering - (media-url &optional full-remote-url type caption sensitive) - "Return the string to be written that renders the image at MEDIA-URL. -FULL-REMOTE-URL is used for `shr-browse-image'. -TYPE is the attachment's type field on the server. -CAPTION is the image caption if provided. -SENSITIVE is a flag from the item's JSON data." - (let* ((help-echo-base - (substitute-command-keys - (concat "\\`RET': load full image or play video,\ - \\`i' for image options" - (when (not (eq sensitive :json-false)) - ", \\`S': toggle sensitive media")))) - (help-echo (if caption - (concat help-echo-base - "\n\"" caption "\"") - help-echo-base))) - (concat - (mastodon-tl--propertize-img-str-or-url - "[img]" media-url full-remote-url type help-echo - (create-image mastodon-media--generic-broken-image-data nil t) - nil caption sensitive) - " "))) - -(provide 'mastodon-media) -;;; mastodon-media.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-notifications.el b/elpa/mastodon-20251201.1553/mastodon-notifications.el deleted file mode 100644 index 113f3a59..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-notifications.el +++ /dev/null @@ -1,975 +0,0 @@ -;;; 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 -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-notification.el provides notification functions for Mastodon. - -;;; Code: - -(require 'subr-x) -(require 'cl-lib) -(require 'mastodon-widget) -(require 'map) - -(autoload 'mastodon-http--api "mastodon-http") -(autoload 'mastodon-http--get-params-async-json "mastodon-http") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--triage "mastodon-http") -(autoload 'mastodon-media--inline-images "mastodon-media") -(autoload 'mastodon-tl--byline "mastodon-tl") -(autoload 'mastodon-tl--byline-author "mastodon-tl") -(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") -(autoload 'mastodon-tl--content "mastodon-tl") -(autoload 'mastodon-tl--field "mastodon-tl") -(autoload 'mastodon-tl--find-property-range "mastodon-tl") -(autoload 'mastodon-tl--has-spoiler "mastodon-tl") -(autoload 'mastodon-tl--init "mastodon-tl") -(autoload 'mastodon-tl--property "mastodon-tl") -(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") -(autoload 'mastodon-tl--spoiler "mastodon-tl") -(autoload 'mastodon-tl--item-id "mastodon-tl") -(autoload 'mastodon-tl-update "mastodon-tl") -(autoload 'mastodon-views-view-follow-requests "mastodon-views") -(autoload 'mastodon-tl--current-filters "mastodon-views") -(autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-notifications-get "mastodon") -(autoload 'mastodon-tl--byline-uname-+-handle "mastodon-tl") -(autoload 'mastodon-tl--byline-handle "mastodon-tl") -(autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-media--get-avatar-rendering "mastodon-media") -(autoload 'mastodon-tl--image-trans-check "mastodon-tl") -(autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--display-or-uname "mastodon-tl") -(autoload 'mastodon-tl-goto-next-item "mastodon-tl") -(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") -(autoload 'mastodon-tl--buffer-property "mastodon-tl") -(autoload 'mastodon-http--patch "mastodon-http") -(autoload 'mastodon-views--minor-view "mastodon-views") -(autoload 'mastodon-tl--goto-first-item "mastodon-tl") -(autoload 'mastodon-tl--init-sync "mastodon-tl") - -;; notifications defcustoms moved into mastodon.el -;; as some need to be available without loading this file - -(defvar mastodon-tl--shr-map-replacement) -(defvar mastodon-tl--horiz-bar) -(defvar mastodon-active-user) -(defvar mastodon-instance-url) -(defvar mastodon-tl--buffer-spec) -(defvar mastodon-tl--display-media-p) -(defvar mastodon-mode-map) -(defvar mastodon-tl--fold-toots-at-length) -(defvar mastodon-tl--show-avatars) -(defvar mastodon-profile-note-in-foll-reqs) -(defvar mastodon-profile-note-in-foll-reqs-max-length) -(defvar mastodon-group-notifications) -(defvar mastodon-notifications-grouped-names-count) -(defvar mastodon-tl--link-keymap) -(defvar mastodon-tl--update-point) -;;; VARIABLES - -(defvar mastodon-notifications--map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map mastodon-mode-map) - (define-key map (kbd "a") #'mastodon-notifications-follow-request-accept) - (define-key map (kbd "j") #'mastodon-notifications-follow-request-reject) - (define-key map (kbd "C-k") #'mastodon-notifications-clear-current) - (define-key map (kbd "C-c C-c") #'mastodon-notifications-cycle-type) - map) - "Keymap for viewing notifications.") - -(defvar mastodon-notifications--types - '("all" "favourite" "reblog" "mention" "poll" - "follow_request" "follow" "status" "update" - "severed_relationships" "moderation_warning" "quote" - "quoted_update") - "A list of notification types according to their name on the server, plus \"all\".") - -(defvar mastodon-notifications--filter-types-alist - '(("all" . mastodon-notifications-get) - ("favourite" . mastodon-notifications-get-favourites) - ("reblog" . mastodon-notifications-get-boosts) - ("mention" . mastodon-notifications-get-mentions) - ("poll" . mastodon-notifications-get-polls) - ("follow_request" . mastodon-notifications-get-follow-requests) - ("follow" . mastodon-notifications-get-follows) - ("status" . mastodon-notifications-get-statuses) - ("update" . mastodon-notifications-get-edits) - ("quote" . mastodon-notifications-get-quotes) - ("quoted_update" . mastodon-notifications-get-quoted-updates)) - "An alist of notification types and their corresponding load functions. -Notification types are named according to their name on the server.") - -(defvar mastodon-notifications--response-alist - '(("Followed" . "you") - ("Favourited" . "your post") - ("Boosted" . "your post") - ("Mentioned" . "you") - ("Posted a poll" . "that has now ended") - ("Requested to follow" . "you") - ("Posted" . "a post") - ("Edited" . "their post") - ("Quoted" . "your post") - ;; FIXME: this is very annoying, but because "Edited" is used above, - ;; we cannot reuse it here. I think this is because we use - ;; `mastodon-notifications--action-alist' to go from (server) notif - ;; type, to a string, and then use that string to get the rest of the - ;; byline string from `mastodon-notifications--response-alist' here. - ;; Ideally would just key the two strings according to notif type, - ;; even if they did need to be gathered separately and combined. - ("Modified" . "a post that you quoted")) - "Alist of subjects for notification types.") - -(defvar mastodon-notifications--action-alist - '((reblog . "Boosted") - (favourite . "Favourited") - (follow_request . "Requested to follow") - (follow . "Followed") - (mention . "Mentioned") - (status . "Posted") - (poll . "Posted a poll") - (update . "Edited") - (severed_relationships . "Relationships severed") - (moderation_warning . "Moderation warning") - (quote . "Quoted") - (quoted_update . "Modified")) - "Action strings keyed by notification type. -Types are those of the Mastodon API.") - -(defvar mastodon-notifications--no-status-notif-alist - '(("moderation_warning" . moderation_warning) - ("severed_relationships" . event) - ("follow" . follow) - ("follow_request" . follow_request))) - -;;; VAR FETCHERS - -(defun mastodon-notifications--action-alist-get (type) - "Return an action string for notification TYPE. -Fetch from `mastodon-notifications--action-alist'. -If no match, return empty string." - (or (alist-get type mastodon-notifications--action-alist) - "")) - -(defun mastodon-notifications--response-alist-get (message) - "Return a response string for MESSAGE. -Fetch from `mastodon-notifications--response-alist'. -If no match, return empty string." - (or (alist-get - message - mastodon-notifications--response-alist nil nil #'equal) - "")) - -;;; UTILS - -(defun mastodon-notifications--api (endpoint) - "Return a notifications API ENDPOINT. -If `mastodon-group-notifications' is non-nil, use API v2." - (mastodon-http--api endpoint - (when mastodon-group-notifications "v2"))) - -;;; FOLL REQS - -(defun mastodon-notifications--follow-request-process (&optional reject) - "Process the follow request at point. -With no argument, the request is accepted. Argument REJECT means -reject the request. Can be called in notifications view or in -follow-requests view." - (if (not (mastodon-tl--find-property-range 'item-json (point))) - (user-error "No follow request at point?") - (let* ((item-json (mastodon-tl--property 'item-json)) - (f-reqs-view-p (string= "follow_requests" - (plist-get mastodon-tl--buffer-spec 'endpoint))) - (f-req-p (or (string= "follow_request" - (mastodon-tl--property 'notification-type - :no-move)) - f-reqs-view-p))) - (if (not f-req-p) - (user-error "No follow request at point?") - (let-alist (or (alist-get 'account item-json) ;notifs - item-json) ;f-reqs - (if (not .id) - (user-error "No account result at point?") - (let ((response - (mastodon-http--post - (mastodon-http--api - (format "follow_requests/%s/%s" - .id (if reject "reject" "authorize")))))) - (mastodon-http--triage - response - (lambda (_) - (if f-reqs-view-p - (mastodon-views-view-follow-requests) - (mastodon-tl--reload-timeline-or-profile)) - (message "Follow request of %s (@%s) %s!" - .username .acct (if reject "rejected" "accepted"))))))))))) - -(defun mastodon-notifications-follow-request-accept () - "Accept a follow request. -Can be called in notifications view or in follow-requests view." - (interactive) - (mastodon-notifications--follow-request-process)) - -(defun mastodon-notifications-follow-request-reject () - "Reject a follow request. -Can be called in notifications view or in follow-requests view." - (interactive) - (mastodon-notifications--follow-request-process :reject)) - -;;; FORMAT NON-STANDARD NOTIFS - -(defun mastodon-notifications--severance-body (json) - "Return a body for a severance notification JSON." - ;; https://docs.joinmastodon.org/entities/RelationshipSeveranceEvent/ - (let-alist json - (concat .type ": " - .target_name - "\nRelationships affected: " - "\nFollowers: " (number-to-string .followers_count) - "\nFollowing: " (number-to-string .following_count)))) - -(defun mastodon-notifications--mod-warning-body (json) - "Return a body for a moderation warning notification JSON." - ;; https://docs.joinmastodon.org/entities/AccountWarning/ - (let-alist json - (concat .action ": \"" (string-trim .text) "\"" - "\nStatuses: " - (mastodon-notifications--render-mod-status-links .status_ids) - "\nfor account: " - .target_account.acct - (if .appeal - (concat "\nYour appeal: \"" - (alist-get 'text .appeal) - "\"") - "") - "\nMore info/appeal: " - (mastodon-notifications--render-mod-link .id)))) - -(defun mastodon-notifications--propertize-link (url help-echo) - "Render a plain URL link with HELP-ECHO." - (propertize - url - 'face 'shr-link ;; mastodon-display-name-face - 'keymap mastodon-tl--shr-map-replacement - 'mastodon-tab-stop 'shr-url - 'help-echo help-echo - 'follow-link t - 'mouse-face 'highlight - 'shr-url url - 'keymap mastodon-tl--shr-map-replacement)) - -(defun mastodon-notifications--render-mod-status-links (ids) - "Render moderation status IDS as URLs." - (mapconcat (lambda (id) - (let ((str (format "%s/@%s/%s" - mastodon-instance-url - mastodon-active-user id))) - (mastodon-notifications--propertize-link str "view toot"))) - ids ", ")) - -(defun mastodon-notifications--render-mod-link (id) - "Render a moderation link for item with ID." - (let ((str (format "%s/disputes/strikes/%s" - mastodon-instance-url id))) - (mastodon-notifications--propertize-link str "View mod warning"))) - -;;; FORMAT/INSERT SINGLE NOTIF - -(defun mastodon-notifications--format-note (note) - "Format for a NOTE, a non-grouped notification." - (let* ((type (intern (alist-get 'type note))) - (profile-note - (when (eq 'follow_request type) - (let ((str (mastodon-tl--field - 'note - (mastodon-tl--field 'account note)))) - (if mastodon-profile-note-in-foll-reqs-max-length - (string-limit str mastodon-profile-note-in-foll-reqs-max-length) - str)))) - (status (mastodon-tl--field 'status note)) - (follower (alist-get 'account note)) - (follower-name (mastodon-notifications--follower-name follower)) - (filtered (mastodon-tl--field 'filtered status)) - (filters (when filtered - (mastodon-tl--current-filters filtered)))) - (if (and filtered (assoc "hide" filters)) - nil - (mastodon-notifications--insert-note - ;; toot - ;; should always be note, otherwise notif data not avail - ;; later on: - note - ;; body - (mastodon-notifications--body-arg - type filters status profile-note follower-name nil note) - ;; action-byline (top) - (mastodon-notifications--action-byline - type nil nil note follower-name) - ;; base toot (always provide) - status - nil nil nil type)))) - -(defun mastodon-notifications--format-group-note (group status accounts) - "Format for a GROUP notification. -STATUS is the status's JSON. -ACCOUNTS is data of the accounts that have reacted to the notification." - (let ((folded nil)) - ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot' - (let-alist group - (let* ((type (intern .type)) - (profile-note - (when (member type '(follow_request)) - (let ((str (mastodon-tl--field 'note (car accounts)))) - (if mastodon-profile-note-in-foll-reqs-max-length - (string-limit str mastodon-profile-note-in-foll-reqs-max-length) - str)))) - (follower (when (member type '(follow follow_request)) - (car accounts))) - (follower-name (mastodon-notifications--follower-name follower)) - (filtered (mastodon-tl--field 'filtered status)) - (filters (when filtered - (mastodon-tl--current-filters filtered)))) - (unless (and filtered (assoc "hide" filters)) - (mastodon-notifications--insert-note - ;; toot - (if (member type '(follow follow_request)) - follower - status) - ;; body - (mastodon-notifications--body-arg - type filters status profile-note follower-name group) - ;; action-byline - (mastodon-notifications--action-byline - type accounts group) - ;; base toot (no need for update/poll/?) - (when (member type '(favourite reblog)) - status) - folded group accounts)))))) - -(defun mastodon-notifications--follower-name (follower) - "Return display_name or username of FOLLOWER." - (if (not (string= "" (alist-get 'display_name follower))) - (alist-get 'display_name follower) - (alist-get 'username follower))) - -(defun mastodon-notifications--comment-note-text (str) - "Add comment face to all text in STR with `shr-text' face only." - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (let (prop) - (while (setq prop (text-property-search-forward 'face 'shr-text t)) - (add-text-properties (prop-match-beginning prop) - (prop-match-end prop) - '(face (mastodon-toot-docs-face shr-text))))) - (buffer-string))) - -(defun mastodon-notifications--body-arg - (type &optional filters status profile-note follower-name group note) - "Prepare a notification body argument. -The string returned is passed to `mastodon-notifications--insert-note'. -TYPE is a symbol, a member of `mastodon-notifiations--types'. -FILTERS STATUS PROFILE-NOTE FOLLOWER-NAME GROUP NOTE." - (let ((body - (if-let* ((match (assoc "warn" filters))) - (mastodon-tl--spoiler status (cadr match)) - (mastodon-tl--clean-tabs-and-nl - (cond ((mastodon-tl--has-spoiler status) - (mastodon-tl--spoiler status)) - ((eq type 'follow_request) - (mastodon-tl--render-text profile-note)) - (t (mastodon-tl--content status))))))) - (cond - ((not (member (symbol-name type) - mastodon-notifications--types)) - "Unknown notification type.") - ((eq type 'follow) - (propertize "Congratulations, you have a new follower!" - 'face 'default - 'item-type 'follow-request)) ;; nav - ((eq type 'follow_request) - (concat - (propertize (format "You have a follow request from %s" - follower-name) - 'face 'default - 'item-type 'follow-request) ;; nav - (when mastodon-profile-note-in-foll-reqs - (concat - ":\n" - (mastodon-notifications--comment-note-text body))))) - ((eq type 'severed_relationships) - (mastodon-notifications--severance-body - (alist-get 'event (or group note)))) - ((eq type 'moderation_warning) - (mastodon-notifications--mod-warning-body - (alist-get 'moderation_warning (or group note)))) - ((member type '(favourite reblog)) - (propertize - (mastodon-notifications--comment-note-text body))) - (t body)))) - -(defun mastodon-notifications--insert-note - (toot body action-byline - &optional base-toot unfolded group accounts type) - "Display the content and byline of timeline element TOOT. -BODY will form the section of the toot above the byline. -AUTHOR-BYLINE is an optional function for adding the author -portion of the byline that takes one variable. By default it is -`mastodon-tl--byline-author'. -ACTION-BYLINE is a string, obtained by calling -`mastodon-notifications--action-byline'. -BASE-TOOT is the JSON of the toot responded to. -UNFOLDED is a boolean meaning whether to unfold or fold item if -foldable. -GROUP is the notification group data. -ACCOUNTS is the notification accounts data. -TYPE is notification type, used for non-group notifs." - (let* ((type (if type - (symbol-name type) ;; non-group - (alist-get 'type group))) - (toot-foldable - (and mastodon-tl--fold-toots-at-length - (length> body mastodon-tl--fold-toots-at-length))) - (ts ;; types listed here use base item timestamp, else we use - ;; group's latest timestamp: - (when (and group - (not - (member type '("favourite" "reblog" "edit" "poll")))) - (mastodon-tl--field 'latest_page_notification_at group)))) - (insert - (propertize ;; top byline, body + byline: - (concat - (if (equal type "mention") ;; top (action) byline - "" - action-byline) - (propertize body ;; body only - 'toot-body t) ;; includes newlines etc. for folding - "\n" - ;; display quoted post: - (when (alist-get 'quote toot) - (mastodon-tl--insert-quoted (alist-get 'quote toot))) - ;; actual byline: - (if (member type '("severed_relationships" "moderation_warning")) - (propertize - (concat mastodon-tl--horiz-bar "\n") - 'byline t) - (mastodon-tl--byline toot nil nil base-toot group ts))) - 'item-type 'toot ;; for nav, actions, etc. - 'item-id (or (alist-get 'page_max_id group) ;; newest notif - (alist-get 'id toot)) ; toot id - 'base-item-id (mastodon-tl--item-id - ;; if status is a notif, get id from base-toot - ;; (-tl--item-id toot) will not work here: - (or base-toot - toot)) ; else normal toot with reblog check - 'item-json toot - 'base-toot base-toot - 'cursor-face 'mastodon-cursor-highlight-face - 'toot-foldable toot-foldable - 'toot-folded (and toot-foldable (not unfolded)) - ;; grouped notifs data: - 'notification-type type - 'notification-id (alist-get 'group_key group) - 'notification-group group - 'notification-accounts accounts - ;; for pagination: - 'notifications-min-id (alist-get 'page_min_id group) - 'notifications-max-id (alist-get 'page_max_id group)) - "\n"))) - -;;; BYLINES - -(defun mastodon-notifications--action-byline - (type &optional accounts group note follower-name) - "Return an action (top) byline for notification of TYPE. -ACCOUNTS and GROUP group are used by grouped notifications. -NOTE and FOLLOWER-NAME are used for non-grouped notifs." - (let* ((str-prefix (mastodon-notifications--action-alist-get type)) - (action-str - (unless (member type '(follow follow_request mention)) - (downcase - (mastodon-notifications--byline-action-str - str-prefix)))) - (action-symbol (if (eq type 'mention) - "" - (mastodon-tl--symbol type))) - (action-authors - (cond - ((not (member (symbol-name type) - mastodon-notifications--types)) - "") - ((member type - '(follow follow_request mention - severed_relationships moderation_warning)) - "") ;; mentions are normal statuses - (group - (mastodon-notifications--byline-accounts accounts group)) - (t (mastodon-tl--byline-handle note nil - follower-name - 'mastodon-display-name-face))))) - (propertize - (concat action-symbol " " action-authors action-str) - 'byline-top t))) - -(defun mastodon-notifications--byline-action-str (message) - "Return an action (top) byline string for TOOT with MESSAGE." - (let ((resp (mastodon-notifications--response-alist-get message))) - (concat " " - (propertize message 'face 'mastodon-boosted-face) - " " resp "\n"))) - -(defun mastodon-notifications--alist-by-value (str field json) - "From JSON, return the alist whose FIELD value matches STR. -JSON is a list of alists." - (cl-some (lambda (y) - (when (string= str (alist-get field y)) - y)) - json)) - -(defun mastodon-notifications--group-accounts (ids json) - "For IDS, return account data in JSON." - (cl-loop - for x in ids - collect (mastodon-notifications--alist-by-value x 'id json))) - -(defun mastodon-notifications--byline-accounts - (accounts group &optional avatar) - "Propertize author byline ACCOUNTS. -GROUP is the group notification data. -When AVATAR, include the account's avatar image." - (let ((total (alist-get 'notifications_count group)) - (accts mastodon-notifications-grouped-names-count)) - (concat - (string-trim ;; remove trailing newline - (cl-loop - for account in accounts - repeat accts - concat - (let-alist account - (concat - ;; avatar insertion moved up to `mastodon-tl--byline' by - ;; default to be outside 'byline propt. - (when (and avatar ; used by `mastodon-profile--format-user' - mastodon-tl--show-avatars - mastodon-tl--display-media-p - (mastodon-tl--image-trans-check)) - (mastodon-media--get-avatar-rendering .avatar)) - (let ((uname (mastodon-tl--display-or-uname account))) - (mastodon-tl--byline-handle account nil - uname 'mastodon-display-name-face)) - ", "))) - nil ", ") - (if (< accts total) - (let ((diff (- total accts))) - (propertize ;; help-echo remaining notifs authors: - (format " and %s other%s" diff (if (= 1 diff) "" "s")) - 'help-echo (mapconcat (lambda (a) - (propertize (alist-get 'username a) - 'face 'mastodon-display-name-face)) - (cddr accounts) ;; not first two - ", "))))))) - -;;; LOAD TIMELINE - -(defun mastodon-notifications--render (json no-group) - "Display grouped notifications in JSON. -NO-GROUP means don't render grouped notifications." - ;; (setq masto-grouped-notifs json) - (let ((start-pos (point))) - (if no-group - (cl-loop for x in json - do (mastodon-notifications--format-note x)) - (cl-loop - for g in (alist-get 'notification_groups json) - for accounts = (mastodon-notifications--group-accounts - (alist-get 'sample_account_ids g) - (alist-get 'accounts json)) - for type = (alist-get 'type g) - for status = (mastodon-notifications--status-or-event g type json) - do (mastodon-notifications--format-group-note g status accounts))) - (when mastodon-tl--display-media-p - ;; images-in-notifs custom is handeld in - ;; `mastodon-tl--media-attachment', not here - (mastodon-media--inline-images start-pos (point))))) - -(defun mastodon-notifications--status-or-event (group type json) - "Return a notification's status or event data. -Using GROUP data, notification TYPE, and overall notifs JSON." - (if (member type (map-keys mastodon-notifications--no-status-notif-alist)) - ;; notifs w no status data: - (let ((key (alist-get type mastodon-notifications--no-status-notif-alist - nil nil #'equal))) - (alist-get key group)) - (mastodon-notifications--alist-by-value - (alist-get 'status_id group) - 'id - (alist-get 'statuses json)))) - -(defun mastodon-notifications--empty-group-json-p (json) - "Non-nil if JSON is empty grouped notifs data." - (equal json '((accounts) (statuses) (notification_groups)))) - -(defun mastodon-notifications--timeline (json &optional type update) - "Format JSON in Emacs buffer. -Optionally specify TYPE. -UPDATE means we are updating, so skip some things." - (if (seq-empty-p json) - (user-error "Looks like you have no (more) notifications for now") - (unless update - (mastodon-widget--create - "Filter" mastodon-notifications--types - (or type "all") - (lambda (widget &rest _ignore) - (let ((value (widget-value widget))) - (mastodon-notifications-get-type value))) - :newline) - (insert "\n")) - ;; filtered/requests message: - (when (mastodon-notifications--notif-requests) - (insert - (substitute-command-keys - "You have filtered notifications. \ -\\[mastodon-notifications-requests] to view requests.\n\n"))) - ;; set update point: - (setq mastodon-tl--update-point (point)) - ;; render: - (mastodon-notifications--render json - (not mastodon-group-notifications)) - (goto-char (point-min)) - ;; set last read notif ID: - (save-excursion - (mastodon-tl-goto-next-item :no-refresh) - (let ((id (mastodon-tl--property 'item-id))) ;; notif not base - (mastodon-notifications--set-last-read id))) - (unless update ;; already in tl--update - (mastodon-tl-goto-next-item)))) - -;;; VIEW LOADING FUNCTIONS - -(defun mastodon-notifications-get-type (&optional type) - "Read a notification type and load its timeline. -Optionally specify TYPE." - (interactive) - (let ((choice (or type - (completing-read - "View notifications: " - mastodon-notifications--filter-types-alist)))) - (funcall (alist-get - choice mastodon-notifications--filter-types-alist - nil nil #'equal)))) - -(defun mastodon-notifications-cycle-type (&optional prefix) - "Cycle the current notifications view. -With arg PREFIX, `completing-read' a type and load it." - (interactive "P") - ;; FIXME: do we need a sept buffer-type result for all notifs views? - (if (not (or (mastodon-tl--buffer-type-eq 'notifications) - (mastodon-tl--buffer-type-eq 'mentions))) - (user-error "Not in a notifications view") - (let* ((choice - (if prefix - (completing-read "Notifs by type: " - mastodon-notifications--types) - (mastodon-notifications--get-next-type))) - (fun (alist-get choice mastodon-notifications--filter-types-alist - nil nil #'equal))) - (funcall fun)))) - -(defun mastodon-notifications--current-type () - "Return the current notification type or nil." - (let* ((update-params (mastodon-tl--buffer-property - 'update-params nil :no-error))) - (alist-get "types[]" update-params nil nil #'equal))) - -(defun mastodon-notifications--get-next-type () - "Return the next notif type based on current buffer spec." - (let* ((type (mastodon-notifications--current-type))) - (if (not type) - (cadr mastodon-notifications--types) - (or (cadr (member type mastodon-notifications--types)) - (car mastodon-notifications--types))))) - -(defun mastodon-notifications-get-mentions () - "Display mention notifications in buffer." - (interactive) - (mastodon-notifications-get "mention" "mentions")) - -(defun mastodon-notifications-get-favourites () - "Display favourite notifications in buffer." - (interactive) - (mastodon-notifications-get "favourite" "favourites")) - -(defun mastodon-notifications-get-boosts () - "Display boost notifications in buffer." - (interactive) - (mastodon-notifications-get "reblog" "boosts")) - -(defun mastodon-notifications-get-polls () - "Display poll notifications in buffer." - (interactive) - (mastodon-notifications-get "poll" "polls")) - -(defun mastodon-notifications-get-statuses () - "Display status notifications in buffer. -Status notifications are created when you call -`mastodon-tl-enable-notify-user-posts'." - (interactive) - (mastodon-notifications-get "status" "statuses")) - -(defun mastodon-notifications-get-follows () - "Display follow notifications in buffer." - (interactive) - (mastodon-notifications-get "follow" "follows")) - -(defun mastodon-notifications-get-follow-requests () - "Display follow request notifications in buffer." - (interactive) - (mastodon-notifications-get "follow_request" "follow-requests")) - -(defun mastodon-notifications-get-edits () - "Display edited post notifications in buffer." - (interactive) - (mastodon-notifications-get "update" "edits")) - -(defun mastodon-notifications--filter-types-list (type) - "Return a list of notification types with TYPE removed." - (remove type mastodon-notifications--types)) - -;;; CLEAR/DISMISS NOTIFS - -(defun mastodon-notifications-clear-all () - "Clear all notifications." - (interactive) - (when (y-or-n-p "Clear all notifications?") - (let ((response - (mastodon-http--post - (mastodon-notifications--api "notifications/clear")))) - (mastodon-http--triage - response (lambda (_) - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "All notifications cleared!")))))) - -(defun mastodon-notifications-clear-current () - "Dismiss the notification at point." - (interactive) - (let* ((id (or ;; grouping enabled - ;; (*should* also work for ungrouped items): - (mastodon-tl--property 'notification-id) - ;; FIXME: are these all required? - (mastodon-tl--property 'item-id) - (mastodon-tl--field - 'id - (mastodon-tl--property 'item-json)))) - (endpoint (mastodon-notifications--api - (format "notifications/%s/dismiss" id))) - (response (mastodon-http--post endpoint))) - (mastodon-http--triage - response (lambda (_) - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "Notification dismissed!"))))) - -;;; MISC - -(defun mastodon-notifications--set-last-read (id) - "Set the last read notification ID on the server." - (let ((endpoint (mastodon-http--api "markers")) - (params `(("notifications[last_read_id]" . ,id)))) - (mastodon-http--post endpoint params))) - -(defun mastodon-notifications--get-last-read () - "Return the last read notification ID from the server." - (let* ((params '(("timeline[]" . "notifications"))) - (endpoint (mastodon-http--api "markers")) - (resp (mastodon-http--get-json endpoint params))) - (map-nested-elt resp '(notifications last_read_id)))) - -(defun mastodon-notifications-get-single-notif () - "Return a single notification JSON for v2 notifs." - (interactive) - (let* ((id ;; grouped (should work for ungrouped items): - (mastodon-tl--property 'notification-id)) - (endpoint (mastodon-notifications--api - (format "notifications/%s" id))) - (response (mastodon-http--get-json endpoint))) - (message "%s" (prin1-to-string response)))) - -(defun mastodon-notifications--get-unread-count () - "Return the number of unread notifications for the current account." - ;; params: limit - max 1000, default 100, types[], exclude_types[], account_id - (let* ((endpoint "notifications/unread_count") - (url (mastodon-http--api endpoint - (when mastodon-group-notifications "v2"))) - (resp (mastodon-http--get-json url))) - (alist-get 'count resp))) - -;;; NOTIFICATION REQUESTS / FILTERING / POLICY - -(defvar mastodon-notifications--requests-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map mastodon-mode-map) - (define-key map (kbd "j") #'mastodon-notifications-request-reject) - (define-key map (kbd "a") #'mastodon-notifications-request-accept) - (define-key map (kbd "g") #'mastodon-notifications-requests) - map) - "Keymap for viewing follow requests.") - -;; FIXME: these are only for grouped notifs, else the fields are JSON bools -(defvar mastodon-notifications-policy-vals - '("accept" "filter" "drop")) - -(defun mastodon-notifications-get-policy () - "Return the notification filtering policy." - (let ((url (mastodon-notifications--api "notifications/policy"))) - (mastodon-http--get-json url))) - -(defun mastodon-notifications--notif-requests () - "Non-nil if the user currently has pending/filtered notifications. -Returns" - (let* ((policy (mastodon-notifications-get-policy)) - (count (map-nested-elt policy '(summary pending_notifications_count)))) - (if (and count (> count 0)) - count))) - -(defun mastodon-notifications--pending-p () - "Non-nil if there are any pending requests or notifications." - (let* ((json (mastodon-notifications-get-policy)) - (summary (alist-get 'summary json))) - (or (not (= 0 (alist-get 'pending_requests_count summary))) - (not (= 0 (alist-get 'pending_notifications_count summary)))))) - -(defun mastodon-notifications--update-policy (&optional params) - "Update notifications filtering policy. -PARAMS is an alist of parameters." - ;; https://docs.joinmastodon.org/methods/notifications/#update-the-filtering-policy-for-notifications - (let ((url (mastodon-notifications--api "notifications/policy"))) - (mastodon-http--patch url params))) - -(defun mastodon-notifications--get-requests (&optional params) - "Get a list of notification requests data from the server. -PARAMS is an alist of parameters." - ;; NB: link header pagination - (let ((url (mastodon-notifications--api "notifications/requests"))) - (mastodon-http--get-json url params))) - -(defun mastodon-notifications-request-accept (&optional reject) - "Accept a notification request for a user. -This will merge any filtered notifications from them into the main -notifications and accept any future notification from them. -REJECT means reject notifications instead." - ;; POST /api/v1/notifications/requests/:id/accept - (interactive) - (let* ((id (mastodon-tl--property 'item-id)) - (user (mastodon-tl--property 'notif-req-user)) - (url (mastodon-http--api - (format "notifications/requests/%s/%s" - id (if reject "dismiss" "accept")))) - (resp (mastodon-http--post url))) - (mastodon-http--triage - resp - (lambda (_resp) - (message "%s notifications from %s" - (if reject "Not accepting" "Accepting") user) - ;; reload view: - (mastodon-notifications-requests))))) - -(defun mastodon-notifications-request-reject () - "Reject a notification request for a user. -Rejecting a request means any notifications from them will continue to -be filtered." - (interactive) - (mastodon-notifications-request-accept :reject)) - -(defun mastodon-notifications-requests () - "Open a new buffer displaying the user's notification requests." - ;; calqued off `mastodon-views-view-follow-requests' - (interactive) - (mastodon-tl--init-sync - "notification-requests" - "notifications/requests" - 'mastodon-views--insert-notification-requests - nil - '(("limit" . "40")) ; server max is 80 - :headers - "notification requests" - "a/j - accept/reject request at point\n\ - n/p - go to next/prev request\n\ - \\[mastodon-notifications-policy] - set filtering policy") - (mastodon-tl--goto-first-item) - (with-current-buffer "*mastodon-notification-requests*" - (use-local-map mastodon-notifications--requests-map))) - -(defun mastodon-views--insert-notification-requests (json) - "Insert the user's current notification requests. -JSON is the data returned by the server." - (mastodon-views--minor-view - "notification requests" - #'mastodon-notifications--insert-users - json)) -;; masto-notif-req)) - -(defun mastodon-notifications--insert-users (json) - "Insert users list into the buffer. -JSON is the data from the server." - ;; calqued off `mastodon-views--insert-users-propertized-note' - ;; and `mastodon-search--insert-users-propertized' - (cl-loop for req in json - do (insert - (concat - (mastodon-notifications--format-req-user req) - mastodon-tl--horiz-bar "\n\n")))) - -(defun mastodon-notifications--format-req-user (req &optional note) - "Format a notification request user, REQ. -NOTE means to include a profile note." - ;; calqued off `mastodon-search--propertize-user' - (let-alist req - (propertize - (concat - (propertize .account.username - 'face 'mastodon-display-name-face - 'byline t - 'notif-req-user .account.username - 'item-type 'notif-req - 'item-id .id) ;; notif req id - " : \n : " - (propertize (concat "@" .account.acct) - 'face 'mastodon-handle-face - 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle - 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" .account.acct) - 'help-echo (concat "Browse user profile of @" .account.acct)) - " : \n" - (when note - (mastodon-tl--render-text .account.note .account)) - "\n") - 'item-json req))) - -(provide 'mastodon-notifications) -;;; mastodon-notifications.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-pkg.el b/elpa/mastodon-20251201.1553/mastodon-pkg.el deleted file mode 100644 index 3b988614..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "mastodon" "20251201.1553" - "Client for fediverse services using the Mastodon API." - '((emacs "28.1") - (persist "0.8") - (tp "0.7")) - :url "https://codeberg.org/martianh/mastodon.el" - :commit "3c00418bfbb13f450551c28a97f8870e8ce3fef9" - :revdesc "3c00418bfbb1" - :authors '(("Johnson Denen" . "johnson.denen@gmail.com") - ("Marty Hiatt" . "mousebot@disroot.org")) - :maintainers '(("Marty Hiatt" . "mousebot@disroot.org"))) diff --git a/elpa/mastodon-20251201.1553/mastodon-profile.el b/elpa/mastodon-20251201.1553/mastodon-profile.el deleted file mode 100644 index 8c947334..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-profile.el +++ /dev/null @@ -1,1110 +0,0 @@ -;;; 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 -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-profile.el generates a stream of users toots. -;; To add -;; - Option to follow -;; - wheather they follow you or not -;; - Show only Media - -;;; Code: -(require 'seq) -(require 'cl-lib) -(require 'persist) -(require 'parse-time) -(require 'mastodon-http) -(eval-when-compile - (require 'mastodon-tl)) -(require 'mastodon-widget) - -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") -(autoload 'mastodon-http--api "mastodon-http.el") -(autoload 'mastodon-http--get-json "mastodon-http.el") -(autoload 'mastodon-http--get-json-async "mastodon-http.el") -(autoload 'mastodon-http--get-response "mastodon-http") -(autoload 'mastodon-http--patch "mastodon-http") -(autoload 'mastodon-http--patch-json "mastodon-http") -(autoload 'mastodon-http--post "mastodon-http.el") -(autoload 'mastodon-http--triage "mastodon-http.el") -(autoload 'mastodon-kill-window "mastodon") -(autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el") -(autoload 'mastodon-media--inline-images "mastodon-media.el") -(autoload 'mastodon-mode "mastodon.el") -(autoload 'mastodon-notifications-follow-request-accept "mastodon-notifications") -(autoload 'mastodon-notifications-follow-request-reject "mastodon-notifications") -(autoload 'mastodon-search--insert-users-propertized "mastodon-search") -(autoload 'mastodon-tl--as-string "mastodon-tl.el") -(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") -(autoload 'mastodon-tl--byline-author "mastodon-tl.el") -(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") -(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") -(autoload 'mastodon-tl--init "mastodon-tl.el") -(autoload 'mastodon-tl--user-handles-get "mastodon-tl") -(autoload 'mastodon-tl--map-alist "mastodon-tl") -(autoload 'mastodon-tl--map-alist-vals-to-alist "mastodon-tl") -(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") -(autoload 'mastodon-tl--property "mastodon-tl.el") -(autoload 'mastodon-tl--render-text "mastodon-tl.el") -(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") -(autoload 'mastodon-tl--set-face "mastodon-tl.el") -(autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--timeline "mastodon-tl.el") -(autoload 'mastodon-tl--toot "mastodon-tl") -(autoload 'mastodon-tl--item-id "mastodon-tl") -(autoload 'mastodon-toot--count-toot-chars "mastodon-toot") -(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") -(autoload 'mastodon-views-add-account-to-list "mastodon-views") -(autoload 'mastodon-return-credential-account "mastodon") -(autoload 'mastodon-tl--buffer-property "mastodon-tl") -(autoload 'mastodon-search-query "mastodon-search") -(autoload 'mastodon-tl--field-status "mastodon-tl") -(autoload 'mastodon-toot--with-toot-item "mastodon-toot" nil nil 'macro) -(autoload 'mastodon-tl--toot-or-base "mastodon-tl") - -(defvar mastodon-active-user) -(defvar mastodon-tl--horiz-bar) -(defvar mastodon-tl--update-point) -(defvar mastodon-toot--max-toot-chars) -(defvar mastodon-toot--visibility) -(defvar mastodon-toot--content-nsfw) -(defvar mastodon-tl--timeline-posts-count) - -(defvar-local mastodon-profile--account nil - "The data for the account being described in the current profile buffer.") - -(defvar mastodon-profile-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle) - (define-key map (kbd "C-c C-s") #'mastodon-profile-account-search) - (define-key map (kbd "C-c #") #'mastodon-profile-open-statuses-tagged) - map) - "Keymap for `mastodon-profile-mode'.") - -(define-minor-mode mastodon-profile-mode - "Toggle mastodon profile minor mode. -This minor mode is used for mastodon profile pages and adds a couple of -extra keybindings." - :init-value nil - :lighter " Profile" - :keymap mastodon-profile-mode-map - :group 'mastodon - :global nil) - -(defvar mastodon-profile-credential-account nil - "Holds the JSON data of the CredentialAccount entity. -It contains details of the current user's account.") - -(defvar mastodon-profile-acccount-preferences-data nil - "Holds the JSON data of the current user's preferences.") - -(defvar mastodon-profile-update-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") #'mastodon-profile-user-profile-send-updated) - (define-key map (kbd "C-c C-k") #'mastodon-profile-update-profile-note-cancel) - map) - "Keymap for `mastodon-profile-update-mode'.") - -(persist-defvar mastodon-profile-account-settings nil - "An alist of account settings saved from the server. -Other clients can change these settings on the server at any -time, so this list is not the canonical source for settings. It -is updated on entering mastodon mode and on toggle any setting it -contains. -This variable is set from data in -`mastodon-profile-credential-account' not -`mastodon-profile-account-preferences-data'.") - -(define-minor-mode mastodon-profile-update-mode - "Minor mode to update user profile." - :group 'mastodon-profile - :keymap mastodon-profile-update-mode-map - :global nil) - -(defun mastodon-profile--item-json () - "Get the next item-json." - (mastodon-tl--property 'item-json)) - -(defun mastodon-profile--make-author-buffer - (account &optional no-reblogs no-replies only-media tag max-id) - "Take an ACCOUNT json and insert a user account into a new buffer. -NO-REBLOGS means do not display boosts in statuses. -NO-REPLIES means to exlude replies. -ONLY-MEDIA means show only posts containing attachments. -TAG is a hashtag to restrict posts to. -MAX-ID is a flag to include the max_id pagination parameter." - (mastodon-profile--make-profile-buffer-for - account "statuses" #'mastodon-tl--timeline no-reblogs nil - no-replies only-media tag max-id)) - -;;; PROFILE VIEW COMMANDS - -(defvar mastodon-profile--account-view-alist - '((statuses . mastodon-profile-open-statuses) - (no-boosts . mastodon-profile-open-statuses-no-reblogs) - (no-replies . mastodon-profile-open-statuses-no-replies) - (only-media . mastodon-profile-open-statuses-only-media) - (followers . mastodon-profile-open-followers) - (following . mastodon-profile-open-following) - (tag . mastodon-profile-open-statuses-tagged))) - -(defun mastodon-profile--view-types () - "Return the keys of `mastodon-profile--account-view-alist' as a list." - (map-keys mastodon-profile--account-view-alist)) - -(defun mastodon-profile-account-view-cycle (&optional prefix) - "Cycle through profile view: toots, toot sans boosts, followers, and following. -If a PREFIX argument is provided, prompt for a view type and load." - (interactive "P") - (if prefix - (let* ((choice - (completing-read "Profile view:" - mastodon-profile--account-view-alist)) - (fun (alist-get choice mastodon-profile--account-view-alist))) - (funcall fun)) - (cond ((mastodon-tl--buffer-type-eq 'profile-statuses) - (mastodon-profile-open-statuses-no-reblogs)) - ((mastodon-tl--buffer-type-eq 'profile-statuses-no-boosts) - (mastodon-profile-open-statuses-no-replies)) - ((mastodon-tl--buffer-type-eq 'profile-statuses-no-replies) - (mastodon-profile-open-statuses-only-media)) - ((mastodon-tl--buffer-type-eq 'profile-statuses-only-media) - (mastodon-profile-open-followers)) - ((mastodon-tl--buffer-type-eq 'profile-followers) - (mastodon-profile-open-following)) - ((mastodon-tl--buffer-type-eq 'profile-following) - (mastodon-profile-open-statuses))))) - -(defun mastodon-profile-open-statuses () - "Open a profile showing statuses." - (interactive) - (if mastodon-profile--account - (mastodon-profile--make-author-buffer - mastodon-profile--account) - (user-error "Not in a mastodon profile"))) - -(defun mastodon-profile-open-statuses-no-replies () - "Open a profile buffer showing statuses without replies." - (interactive) - (if mastodon-profile--account - (mastodon-profile--make-author-buffer - mastodon-profile--account nil :no-replies) - (user-error "Not in a mastodon profile"))) - -(defun mastodon-profile-open-statuses-no-reblogs () - "Open a profile buffer showing statuses without reblogs." - (interactive) - (if mastodon-profile--account - (mastodon-profile--make-author-buffer - mastodon-profile--account :no-reblogs) - (user-error "Not in a mastodon profile"))) - -(defun mastodon-profile-open-statuses-only-media () - "Open a profile buffer showing only statuses with media." - (interactive) - (if mastodon-profile--account - (mastodon-profile--make-author-buffer - mastodon-profile--account nil nil :only-media) - (user-error "Not in a mastodon profile"))) - -(defun mastodon-profile-open-statuses-tagged () - "Prompt for a hashtag and display a profile with only statuses containing it." - (interactive) - (let ((tag (read-string "Statuses containing tag: "))) - (if mastodon-profile--account - (mastodon-profile--make-author-buffer - mastodon-profile--account nil nil nil tag) - (user-error "Not in a mastodon profile")))) - -(defun mastodon-profile-open-following () - "Open a profile buffer showing the accounts that current profile follows." - (interactive) - (if mastodon-profile--account - (mastodon-profile--make-profile-buffer-for - mastodon-profile--account "following" - #'mastodon-profile--format-user nil :headers) - (user-error "Not in a mastodon profile"))) - -(defun mastodon-profile-open-followers () - "Open a profile buffer showing the accounts following the current profile." - (interactive) - (if mastodon-profile--account - (mastodon-profile--make-profile-buffer-for - mastodon-profile--account "followers" - #'mastodon-profile--format-user nil :headers) - (user-error "Not in a mastodon profile"))) - -(defun mastodon-profile-view-favourites () - "Open a new buffer displaying the user's favourites." - (interactive) - (message "Loading your favourited toots...") - (mastodon-tl--init "favourites" "favourites" - 'mastodon-tl--timeline :headers)) - -(defun mastodon-profile-view-bookmarks () - "Open a new buffer displaying the user's bookmarks." - (interactive) - (message "Loading your bookmarked toots...") - (mastodon-tl--init "bookmarks" "bookmarks" - 'mastodon-tl--timeline :headers)) - -(defun mastodon-profile-add-account-to-list () - "Add account of current profile buffer to a list." - (interactive) - (if (not mastodon-profile--account) - (user-error "No profile to add?") - (let-alist mastodon-profile--account - (mastodon-views-add-account-to-list nil .id .acct)))) - -(defun mastodon-profile-account-search (query) - "Run a statuses search QUERY for the currently viewed account." - (interactive "sSearch account for: ") - (let* ((ep (mastodon-tl--buffer-property 'endpoint)) - (id (nth 1 (split-string ep "/")))) - (mastodon-search-query query "statuses" nil nil id))) - - -;;; ACCOUNT PREFERENCES - -(defun mastodon-profile--get-account-value (key function) - "Fetch KEY from data returned by FUNCTION. -If value is :json-false, return nil." - (let* ((response (funcall function)) - (value (alist-get key response))) - (if (eq value :json-false) nil value))) - -(defun mastodon-profile--get-json-value (key) - "Fetch value for KEY from account. -Account details are from `mastodon-return-credential-account'. -If value is :json-false, return nil." - (mastodon-profile--get-account-value - key #'mastodon-return-credential-account)) - -(defun mastodon-profile--get-source-values () - "Return the \"source\" preferences from the server." - (mastodon-profile--get-json-value 'source)) - -(defun mastodon-profile--get-source-value (pref) - "Return PREF erence from the account's \"source\" field." - (mastodon-profile--get-account-value - pref #'mastodon-profile--get-source-values)) - -(defun mastodon-profile-update-user-profile-note () - "Fetch user's profile note and display for editing." - (interactive) - (let* ((source (mastodon-profile--get-source-values)) - (note (alist-get 'note source)) - (buffer (get-buffer-create "*mastodon-update-profile*")) - (inhibit-read-only t) - (msg-str - (substitute-command-keys - "Edit your profile note. \\`C-c C-c' to send, \\`C-c C-k' to cancel."))) - (switch-to-buffer-other-window buffer) - (text-mode) - (mastodon-tl--set-buffer-spec (buffer-name buffer) - "accounts/verify_credentials" nil) - (setq-local header-line-format msg-str) - (mastodon-profile-update-mode t) - (insert (propertize (concat - (propertize "0" - 'note-counter t - 'display nil) - "/500 characters") - 'read-only t - 'face 'mastodon-toot-docs-face - 'note-header t) - "\n") - (make-local-variable 'after-change-functions) - (cl-pushnew #'mastodon-profile--update-note-count after-change-functions) - (let ((start-point (point))) - (insert note) - (goto-char start-point)) - (delete-trailing-whitespace) ; remove all ^M's - (message msg-str))) - -(defun mastodon-profile--update-note-count (&rest _args) - "Display the character count of the profile note buffer." - (let* ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'note-header - (point-min))) - (count-region (mastodon-tl--find-property-range 'note-counter - (point-min))) - (count (number-to-string (mastodon-toot--count-toot-chars - (buffer-substring-no-properties - (cdr header-region) (point-max)))))) - (add-text-properties (car count-region) (cdr count-region) - (list 'display count)))) - -(defun mastodon-profile-update-profile-note-cancel () - "Cancel updating user profile and kill buffer and window." - (interactive) - (when (y-or-n-p "Cancel updating your profile note?") - (mastodon-kill-window))) - -(defun mastodon-profile--note-remove-header () - "Get the profile note, without the buffer header." - (let ((header-region (mastodon-tl--find-property-range 'note-header - (point-min)))) - (buffer-substring (cdr header-region) (point-max)))) - -(defun mastodon-profile-user-profile-send-updated () - "Send PATCH request with the updated profile note. -Ask for confirmation if length > 500 characters." - (interactive) - (let* ((note (mastodon-profile--note-remove-header)) - (url (mastodon-http--api "accounts/update_credentials"))) - (when (or (not (> (mastodon-toot--count-toot-chars note) 500)) - (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?")) - (quit-window 'kill) - (mastodon-profile--user-profile-send-updated-do url note)))) - -(defun mastodon-profile--user-profile-send-updated-do (url note) - "Send PATCH request with the updated profile NOTE to URL." - (let ((response (mastodon-http--patch url `(("note" . ,note))))) - (mastodon-http--triage response - (lambda (_) (message "Profile note updated!"))))) - -(defun mastodon-profile--update-preference (pref val &optional source) - "Update account PREF erence to setting VAL. -Both args are strings. -SOURCE means that the preference is in the `source' part of the account JSON." - (let* ((url (mastodon-http--api "accounts/update_credentials")) - (pref-formatted (if source (concat "source[" pref "]") pref)) - (response (mastodon-http--patch url `((,pref-formatted . ,val))))) - (mastodon-http--triage response - (lambda (_) - (mastodon-profile--fetch-server-account-settings) - (message "Account setting %s updated to %s!" pref val))))) - -(defun mastodon-profile--get-pref (pref) - "Return PREF from `mastodon-profile-account-settings'." - (plist-get mastodon-profile-account-settings pref)) - -(defun mastodon-profile--update-preference-plist (pref val) - "Set local account preference plist preference PREF to VAL. -This is done after changing the setting on the server." - (setq mastodon-profile-account-settings - (plist-put mastodon-profile-account-settings pref val))) - -;; used in toot.el -(defun mastodon-profile--fetch-server-account-settings-maybe () - "Fetch account settings from the server. -Only do so if `mastodon-profile-account-settings' is nil." - (mastodon-profile--fetch-server-account-settings :no-force)) - -;; FIXME: this does one request per setting! should just do one request then -;; parse -(defun mastodon-profile--fetch-server-account-settings (&optional no-force) - "Fetch basic account settings from the server. -Store the values in `mastodon-profile-account-settings'. -Run in `mastodon-mode-hook'. -If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." - (unless (and no-force mastodon-profile-account-settings) - (let ((keys '(locked discoverable display_name bot)) - (source-keys '(privacy sensitive language))) - (mapc (lambda (k) - (mastodon-profile--update-preference-plist - k (mastodon-profile--get-json-value k))) - keys) - (mapc (lambda (sk) - (mastodon-profile--update-preference-plist - sk (mastodon-profile--get-source-value sk))) - source-keys) - ;; hack for max toot chars: - (mastodon-toot--get-max-toot-chars :no-toot) - (mastodon-profile--update-preference-plist 'max_toot_chars - mastodon-toot--max-toot-chars) - ;; TODO: remove now redundant vars, replace with fetchers from the plist - (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) - mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) - mastodon-profile-account-settings))) - -(defun mastodon-profile-account-locked-toggle () - "Toggle the locked status of your account. -Locked means follow requests have to be approved." - (interactive) - (mastodon-profile--toggle-account-key 'locked)) - -(defun mastodon-profile-account-discoverable-toggle () - "Toggle the discoverable status of your account. -Discoverable means the account is listed in the server directory." - (interactive) - (mastodon-profile--toggle-account-key 'discoverable)) - -(defun mastodon-profile-account-bot-toggle () - "Toggle the bot status of your account." - (interactive) - (mastodon-profile--toggle-account-key 'bot)) - -(defun mastodon-profile-account-sensitive-toggle () - "Toggle the sensitive status of your account. -When enabled, statuses are marked as sensitive by default." - (interactive) - (mastodon-profile--toggle-account-key 'sensitive :source)) - -(defun mastodon-profile--toggle-account-key (key &optional source) - "Toggle the boolean account setting KEY. -SOURCE means the setting is located under \"source\" in the account JSON. -Current settings are fetched from the server." - (let* ((val (if source - (mastodon-profile--get-source-value key) - (mastodon-profile--get-json-value key))) - (prompt (format "Account setting %s is %s. Toggle?" key val))) - (when (y-or-n-p prompt) - (mastodon-profile--update-preference (symbol-name key) - (if val "false" "true") - source)))) - -(defun mastodon-profile--edit-string-value (key) - "Edit the string for account preference KEY." - (let* ((val (mastodon-profile--get-json-value key)) - (new-val (read-string (format "Edit account setting %s: " key) - val))) - (mastodon-profile--update-preference (symbol-name key) new-val))) - -(defun mastodon-profile-update-display-name () - "Update display name for your account." - (interactive) - (mastodon-profile--edit-string-value 'display_name)) - -(defun mastodon-profile--make-meta-fields-params (fields) - "Construct a parameter query string from metadata alist FIELDS. -Returns an alist." - (let ((keys - (cl-loop - for count from 1 to 5 - collect (cons (format "fields_attributes[%s][name]" count) - (format "fields_attributes[%s][value]" count))))) - (cl-loop for a-pair in keys - for b-pair in fields - append (list (cons (car a-pair) (car b-pair)) - (cons (cdr a-pair) (cdr b-pair)))))) - -(defun mastodon-profile-update-meta-fields () - "Prompt for new metadata fields information and PATCH the server." - (interactive) - (let* ((url (mastodon-http--api "accounts/update_credentials")) - (fields-updated (mastodon-profile--update-meta-fields-alist)) - (params (mastodon-profile--make-meta-fields-params fields-updated)) - (response (mastodon-http--patch url params))) - (mastodon-http--triage response - (lambda (_) - (mastodon-profile--fetch-server-account-settings) - (message "Metadata fields updated to %s!" - fields-updated))))) - -(defun mastodon-profile--update-meta-fields-alist () - "Prompt for new metadata fields information. -Returns the results as an alist." - (let ((fields-old (mastodon-profile--fields-get - nil ;; we must fetch the plaintext version: - (mastodon-profile--get-source-value 'fields)))) - ;; offer empty fields if user currently has less than four filled: - (while (< (length fields-old) 4) - (setq fields-old (append fields-old '(("" . ""))))) - (let* ((f-str "Metadata %s [%s/4] (max. 255 chars): ") - (alist - (cl-loop for f in fields-old - for x from 1 to 5 - collect - (cons (read-string (format f-str "key" x) (car f)) - (read-string (format f-str "value" x) (cdr f)))))) - (mapcar (lambda (x) - (cons (mastodon-profile--limit-to-255 (car x)) - (mastodon-profile--limit-to-255 (cdr x)))) - alist)))) - -(defun mastodon-profile--limit-to-255 (x) - "Limit string X to 255 chars max." - (if (> (length x) 255) (substring x 0 255) x)) - -;; used in tl.el and toot.el: -(defun mastodon-profile--get-preferences-pref (pref) - "Fetch PREF from the endpoint \"/preferences\". -If `mastodon-profile-acccount-preferences-data' is set, fetch -from that instead. -The endpoint only holds a few preferences. For others, see -`mastodon-profile--update-preference' and its endpoint, -\"/accounts/update_credentials.\"" - (alist-get pref - (or mastodon-profile-acccount-preferences-data - (setq mastodon-profile-acccount-preferences-data - (mastodon-http--get-json - (mastodon-http--api "preferences")))))) - -(defun mastodon-profile-view-preferences () - "View user preferences in another window." - (interactive) - (let* ((url (mastodon-http--api "preferences")) - (response (mastodon-http--get-json url)) - (buf (get-buffer-create "*mastodon-preferences*"))) - (with-mastodon-buffer buf #'special-mode :other-window - (mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil) - (while-let ((el (pop response))) - (insert (format "%-30s %s" - (prin1-to-string (car el)) - (prin1-to-string (cdr el))) - "\n\n")) - (goto-char (point-min))))) - - -;;; PROFILE VIEW DETAILS - -(defun mastodon-profile--relationships-get (id) - "Fetch info about logged-in user's relationship to user with id ID." - (let* ((args `(("id[]" . ,id))) - (url (mastodon-http--api "accounts/relationships"))) - ;; FIXME: API takes array, we just get 1st - (car (mastodon-http--get-json url args)))) - -(defun mastodon-profile--fields-get (&optional account fields) - "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. -Returns an alist. -FIELDS means provide a fields vector fetched by other means." - (let ((fields (or fields (alist-get 'fields account)))) - (when fields - (mastodon-tl--map-alist-vals-to-alist 'name 'value fields)))) - -(defun mastodon-profile--fields-insert (fields) - "Format and insert field pairs (a.k.a profile metadata) in FIELDS." - (let* ((car-fields (mapcar #'car fields)) - (left-width (apply #'max (mapcar #'length car-fields)))) - (mapconcat (lambda (field) - (mastodon-tl--render-text - (concat - (format "_ %s " (car field)) - (make-string (- (+ 1 left-width) (length (car field))) ?_) - (format " :: %s" (cdr field))) - field)) ; hack to make links tabstops - fields ""))) - -(defun mastodon-profile--get-statuses-pinned (account) - "Fetch the pinned toots for ACCOUNT." - (let* ((id (alist-get 'id account)) - (args `(("pinned" . "true"))) - (url (mastodon-http--api (format "accounts/%s/statuses" id)))) - (mastodon-http--get-json url args))) - -(defun mastodon-profile--insert-statuses-pinned (pinned-statuses) - "Insert each of the PINNED-STATUSES for a given account." - (cl-loop for s in pinned-statuses - do (progn - (insert - (concat "\n " - (propertize " pinned " - 'face '(:inherit success :box t)) - " ")) - (mastodon-tl--toot s)))) - -(defun mastodon-profile--follows-p (list) - "T if you have any relationship with the accounts in LIST." - (let (result) - (dolist (x list result) - (when (not (eq :json-false x)) - (setq result x))))) - -(defun mastodon-profile--render-roles (roles) - "Return a propertized string of badges for ROLES." - (mapconcat - (lambda (role) - (propertize (alist-get 'name role) - 'face `(:box t :foreground ,(alist-get 'color role)))) - roles)) - -(defun mastodon-profile--render-moved (data) - "Return a propertized string of a migrated account link. -DATA is an account data from a moved field in profile data." - (let-alist data - (let ((handle (concat "@" .acct))) - (concat - "this account has migrated to: " - (mastodon-tl--buttonify-link - handle - 'face 'shr-link ;'mastodon-handle-face - 'mastodon-tab-stop 'user-handle - 'shr-url .url - 'mastodon-handle handle - 'help-echo (concat "Browse user profile of " handle)) - "\n\n")))) - -(defun mastodon-profile--make-profile-buffer-for - (account endpoint-type update-function - &optional no-reblogs headers no-replies only-media tag max-id) - "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. -NO-REBLOGS means do not display boosts in statuses. -HEADERS means also fetch link headers for pagination. -NO-REPLIES means to exlude replies. -ONLY-MEDIA means show only posts containing attachments. -TAG is a hashtag to restrict posts to. -MAX-ID is a flag to include the max_id pagination parameter." - (let-alist account - (let* ((max-id-str (when max-id - (mastodon-tl--buffer-property 'max-id))) - (args `(("limit" . ,mastodon-tl--timeline-posts-count) - ,(when max-id `("max_id" . ,max-id-str)))) - (args (cond (no-reblogs - (push '("exclude_reblogs" . "t") args)) - (no-replies - (push '("exclude_replies" . "t") args)) - (only-media - (push '("only_media" . "t") args)) - (tag - (push `("tagged" . ,tag) args)) - (t args))) - (endpoint (format "accounts/%s/%s" .id endpoint-type)) - (url (mastodon-http--api endpoint)) - (buffer (concat "*mastodon-" .acct "-" - (concat endpoint-type - (cond (no-reblogs "-no-boosts") - (no-replies "-no-replies") - (only-media "-only-media") - (tag (format "-tagged-%s" tag)) - (t ""))) - "*")) - (response (if headers - (mastodon-http--get-response url args) - (mastodon-http--get-json url args))) - (json (if headers (car response) response)) - (link-header (when headers - (mastodon-tl--get-link-header-from-response - (cdr response)))) - (fields (mastodon-profile--fields-get account)) - (pinned (mastodon-profile--get-statuses-pinned account)) - (relationships (mastodon-profile--relationships-get .id))) - (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-profile-mode) - (setq mastodon-profile--account account) - (mastodon-tl--set-buffer-spec buffer endpoint update-function - link-header args nil max-id-str) - (let* ((inhibit-read-only t)) - (insert - (propertize - (concat - "\n" - (mastodon-profile--image-from-account account 'avatar_static) - (mastodon-profile--image-from-account account 'header_static) - "\n" - (when .display_name - (propertize (if (string-empty-p .display_name) - .username - .display_name) - 'face 'mastodon-display-name-face)) - ;; roles - (when .roles - (concat " " (mastodon-profile--render-roles .roles))) - "\n" - (propertize (concat "@" .acct) 'face 'default) - (when (eq .locked t) - (concat " " (mastodon-tl--symbol 'locked))) - "\n " mastodon-tl--horiz-bar "\n" - ;; migration: - (when .moved - (mastodon-profile--render-moved .moved)) - ;; profile note: - (mastodon-tl--render-text .note account) ; account = tab-stops in profile - ;; meta fields: - (when fields - (concat "\n" (mastodon-tl--set-face - (mastodon-profile--fields-insert fields) - 'success))) - "\n" - ;; Joined date: - (propertize - (mastodon-profile--format-joined-date-string .created_at) - 'face 'success) - "\n\n") - 'profile-json account) - ;; insert counts - (mastodon-tl--set-face - (concat " " mastodon-tl--horiz-bar "\n" - " TOOTS: " (mastodon-tl--as-string .statuses_count) " | " - "FOLLOWERS: " (mastodon-tl--as-string .followers_count) " | " - "FOLLOWING: " (mastodon-tl--as-string .following_count) "\n" - " " mastodon-tl--horiz-bar "\n\n") - 'success) - ;; insert relationship (follows) - (let-alist relationships - (if (not .id) - ;; sharkey has no relationships endpoint, returns 500. - ;; or poss it has a different endpoint - "" - (let* ((followsp (mastodon-profile--follows-p - (list .requested_by .following .followed_by .blocked_by))) - (rels (mastodon-profile--relationships-get .id)) - (langs-filtered (if-let* ((langs (alist-get 'languages rels))) - (concat " (" - (mapconcat #'identity langs " ") - ")") - ""))) - (if followsp - (mastodon-tl--set-face - (concat (when (eq .following t) - (format " | FOLLOWED BY YOU%s" langs-filtered)) - (when (eq .followed_by t) - " | FOLLOWS YOU") - (when (eq .requested_by t) - " | REQUESTED TO FOLLOW YOU") - (when (eq .blocked_by t) - " | BLOCKS YOU") - "\n\n") - 'success) - ""))))) ; for insert call - (mastodon-media--inline-images (point-min) (point)) - ;; widget items description - (mastodon-widget--create - "View" (mastodon-profile--view-types) - (or (mastodon-profile--current-view-type - endpoint-type no-reblogs no-replies only-media tag) - 'statuses) - (lambda (widget &rest _ignore) - (let ((value (widget-value widget))) - (funcall - (alist-get value - mastodon-profile--account-view-alist))))) - (insert "\n") - (setq mastodon-tl--update-point (point)))) - ;; split insert of items from insert of profile: - (with-current-buffer buffer - (let* ((inhibit-read-only t)) - ;; insert pinned toots first - (when (and pinned (string= endpoint-type "statuses")) - (let ((beg (point))) - (mastodon-profile--insert-statuses-pinned pinned) - (setq mastodon-tl--update-point (point)) - (mastodon-media--inline-images beg (point)))) ; updates after pinned toots - ;; insert items - (funcall update-function json) - (goto-char (point-min)) - (message - (substitute-command-keys - ;; "\\[mastodon-profile-account-view-cycle]" ; not always bound? - "\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\ - only media, followers, following. -\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag."))))))) - -(defun mastodon-profile--current-view-type (type no-reblogs no-replies - only-media tag) - "Return the type of current profile view. -Return a member of `mastodon-profile--view-types', based on TYPE, -NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG." - (cond (no-reblogs 'no-boosts) - (no-replies 'no-replies) - (only-media 'only-media) - (tag 'tag) - (t (if (stringp type) (intern type) type)))) - -(defun mastodon-profile--format-joined-date-string (joined) - "Format a human-readable Joined string from timestamp JOINED. -JOINED is the `created_at' field in profile account JSON, and of -the format \"2000-01-31T00:00:00.000Z\"." - (format-time-string "Joined: %d %B %Y" - (parse-iso8601-time-string joined))) - -(defun mastodon-profile-get-toot-author (&optional max-id) - "Open profile of author of toot under point. -If toot is a boost, load the profile of the author of the original item. -MAX-ID is a flag to include the max_id pagination parameter." - (interactive) - (mastodon-tl--do-if-item - (let ((json (mastodon-tl--toot-or-base - (mastodon-profile--item-json)))) - (mastodon-profile--make-author-buffer - (alist-get 'account json) - nil nil nil nil max-id)))) - -(defun mastodon-profile--image-from-account (account img-type) - "Return a avatar image from ACCOUNT. -IMG-TYPE is the JSON key from the account data." - (let ((img (alist-get img-type account))) - (unless (string= img "/avatars/original/missing.png") - (mastodon-media--get-media-link-rendering img)))) - -(defun mastodon-profile-show-user (user-handle) - "Query for USER-HANDLE from current status and show that user's profile." - (interactive - (list - (if (and (not (mastodon-tl--profile-buffer-p)) - (not (mastodon-tl--property 'item-json :no-move))) - (user-error "Looks like there's no toot or user at point?") - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--item-json)))) - (completing-read "View profile of user [choose or enter any handle]: " - user-handles - nil ; predicate - 'confirm))))) - (if (not (or ; own profile has no need for item-json test: - (string= user-handle (mastodon-auth--get-account-name)) - (mastodon-tl--profile-buffer-p) - (mastodon-tl--property 'item-json :no-move))) - (user-error "Looks like there's no toot or user at point?") - (let ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--item-json)))) - (if (not account) - (user-error "Cannot find a user with handle %S" user-handle) - (progn - (message "Loading profile of user %s..." user-handle) - (mastodon-profile--make-author-buffer account)))))) - -(defun mastodon-profile-my-profile () - "Show the profile of the currently signed in user." - (interactive) - (message "Loading your profile...") - (let ((account (mastodon-profile--account-from-id - (mastodon-auth--get-account-id)))) - (mastodon-profile--make-author-buffer account))) - -(defun mastodon-profile--format-user (tootv) - "Convert TOOTV into author-bylines and insert. -Also insert their profile note. -Used to view a user's followers and those they're following." - (let ((inhibit-read-only t)) - (unless (seq-empty-p tootv) - (mapc - (lambda (toot) - (let ((start-pos (point))) - (insert - "\n" - (propertize - (mastodon-tl--byline-author `((account . ,toot)) :avatar nil :base) - 'byline 't - 'item-id (alist-get 'id toot) - 'base-item-id (mastodon-tl--item-id toot) - 'item-json toot)) - (mastodon-media--inline-images start-pos (point)) - (insert "\n" - (propertize - (mastodon-tl--render-text (alist-get 'note toot) nil) - 'item-json toot) - "\n"))) - tootv)))) - -(defun mastodon-profile--search-account-by-handle (handle) - "Return an account based on a user's HANDLE. -If the handle does not match a search return then retun NIL." - (let* ((handle (if (string= "@" (substring handle 0 1)) - (substring handle 1 (length handle)) - handle)) - (args `(("q" . ,handle) - ("type" . "accounts"))) - (result (mastodon-http--get-json - (mastodon-http--api-v2 "search") args)) - (matching-account (seq-remove - (lambda (x) - (not (string= handle (alist-get 'acct x)))) - (alist-get 'accounts result)))) - (when (eq 1 (length matching-account)) - (elt matching-account 0)))) - -(defun mastodon-profile--account-from-id (user-id) - "Request an account object relating to a USER-ID." - (mastodon-http--get-json - (mastodon-http--api (format "accounts/%s" user-id)))) - -(defun mastodon-profile--extract-users-handles (status) - "Return all user handles found in STATUS. -These include the author, author of reblogged entries and any user mentioned." - (when status - (let ((this-account (or (alist-get 'account status) ; status is a toot - status)) ; status is a user listing - (mentions (mastodon-tl--field-status 'mentions status)) - (reblog (mastodon-tl--field-status 'reblog status))) - (seq-remove - (lambda (x) (string= x mastodon-active-user)) - (seq-filter #'stringp - (seq-uniq - (seq-concatenate - 'list - (list (alist-get 'acct this-account)) - (mastodon-profile--extract-users-handles reblog) - (mastodon-tl--map-alist 'acct mentions)))))))) - -(defun mastodon-profile--lookup-account-in-status (handle status) - "Return account for HANDLE using hints in STATUS if possible." - (let* ((this-account (alist-get 'account status)) - (reblog-account (alist-get 'account (alist-get 'reblog status))) - (mention-id (seq-some - (lambda (mention) - (when (string= handle (alist-get 'acct mention)) - (alist-get 'id mention))) - (alist-get 'mentions status)))) - (cond ((string= handle (alist-get 'acct this-account)) - this-account) - ((string= handle (alist-get 'acct reblog-account)) - reblog-account) - (mention-id - (mastodon-profile--account-from-id mention-id)) - (t - (mastodon-profile--search-account-by-handle handle))))) - -;;; REMOVE - -(defun mastodon-profile-remove-user-from-followers (&optional id) - "Remove a user from your followers. -Optionally provide the ID of the account to remove." - (interactive) - (let* ((account (unless id (mastodon-tl--property 'item-json :no-move))) - (id (or id (alist-get 'id account))) - (handle (let ((account (or account - (mastodon-profile--account-from-id id)))) - (alist-get 'acct account))) - (url (mastodon-http--api - (format "accounts/%s/remove_from_followers" id)))) - (when (y-or-n-p (format "Remove follower %s? " handle)) - (let ((response (mastodon-http--post url))) - (mastodon-http--triage response - (lambda (_) - (message "Follower %s removed!" handle))))))) - -(defun mastodon-profile-remove-from-followers-at-point () - "Prompt for a user in the item at point and remove from followers." - (interactive) - (let* ((handles (mastodon-profile--extract-users-handles - (mastodon-profile--item-json))) - (handle (completing-read "Remove from followers: " handles)) - (account (mastodon-profile--lookup-account-in-status - handle (mastodon-profile--item-json))) - (id (alist-get 'id account))) - (mastodon-profile-remove-user-from-followers id))) - -(defun mastodon-profile-remove-from-followers-list () - "Select a user from your followers and remove from followers. -Currently limited to 100 handles. If not found, try -`mastodon-search-query'." - (interactive) - (let* ((endpoint (format "accounts/%s/followers" - (mastodon-auth--get-account-id))) - (url (mastodon-http--api endpoint)) - (response (mastodon-http--get-json url `(("limit" . "100")))) - (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response)) - (choice (completing-read "Remove from followers: " handles)) - (id (alist-get choice handles))) - (mastodon-profile-remove-user-from-followers id))) - -;;; PRIVATE NOTES - -(defun mastodon-profile-add-private-note-to-account () - "Add a private note to an account. -Can be called from a profile page or normal timeline. -Send an empty note to clear an existing one." - (interactive) - (mastodon-profile--add-or-view-private-note - 'mastodon-profile--post-private-note-to-account - "add a note to")) - -(defun mastodon-profile--post-private-note-to-account (id handle note-old) - "POST a private note onto an account ID with user HANDLE on the server. -NOTE-OLD is the text of any existing note." - (let* ((note (read-string - (format "Add private note to account %s: " handle) - note-old)) - (params `(("comment" . ,note))) - (url (mastodon-http--api (format "accounts/%s/note" id))) - (response (mastodon-http--post url params))) - (mastodon-http--triage response - (lambda (_) - (message "Private note on %s added!" handle))))) - -(defun mastodon-profile-view-account-private-note () - "Display the private note about a user." - (interactive) - (mastodon-profile--add-or-view-private-note - 'mastodon-profile--display-private-note - "view private note of" - :view)) - -(defun mastodon-profile--display-private-note (note) - "Display private NOTE in a temporary buffer." - (with-output-to-temp-buffer "*mastodon-profile-private-note*" - (let ((inhibit-read-only t)) - (princ note)))) - -(defun mastodon-profile--profile-json () - "Return the profile-json property if we are in a profile buffer." - (if (not (mastodon-tl--profile-buffer-p)) - (error "Not viewing a profile") - (save-excursion - (goto-char (point-min)) - (or (mastodon-tl--property 'profile-json :no-move) - (error "No profile data found"))))) - -(defun mastodon-profile--add-or-view-private-note (action-fun - &optional message view) - "Add or view a private note for an account. -ACTION-FUN does the adding or viewing, MESSAGE is a prompt for -`mastodon-tl--user-handles-get', VIEW is a flag." - (let* ((profile-json (mastodon-profile--profile-json)) - (handle (if (mastodon-tl--profile-buffer-p) - (alist-get 'acct profile-json) - (mastodon-tl--user-handles-get message))) - (account (if (mastodon-tl--profile-buffer-p) - profile-json - (mastodon-profile--search-account-by-handle handle))) - (id (alist-get 'id account)) - (relationships (mastodon-profile--relationships-get id)) - (note (alist-get 'note relationships))) - (if view - (if (string-empty-p note) - (user-error "No private note for %s" handle) - ;; `mastodon-profile--display-private-note' takes 1 arg: - (funcall action-fun note)) - ;; `mastodon-profile--post-private-note-to-account' takes 3 args: - (funcall action-fun id handle note)))) - -;;; FAMILIAR FOLLOWERS - -(defun mastodon-profile-show-familiar-followers () - "Show a list of familiar followers. -Familiar followers are accounts that you follow, and that follow -the given account." - (interactive) - (let* ((profile-json (mastodon-profile--profile-json)) - (handle - (if (mastodon-tl--profile-buffer-p) - (alist-get 'acct profile-json) - (mastodon-tl--user-handles-get "show familiar followers of"))) - (account (if (mastodon-tl--profile-buffer-p) - profile-json - (mastodon-profile--search-account-by-handle handle))) - (id (alist-get 'id account))) - (mastodon-profile--get-familiar-followers id))) - -(defun mastodon-profile--get-familiar-followers (id) - "Return JSON data of familiar followers for account ID." - ;; the server handles multiple IDs, but we just handle one. - (let* ((params `(("id" . ,id))) - (url (mastodon-http--api "accounts/familiar_followers")) - (json (mastodon-http--get-json url params)) - (accounts (alist-get 'accounts (car json))) ; first id - (handles (mastodon-tl--map-alist 'acct accounts))) - (if (null handles) - (user-error "Looks like there are no familiar followers for this account") - (let ((choice (completing-read "Show profile of user: " handles))) - (mastodon-profile-show-user choice))))) - -(provide 'mastodon-profile) -;;; mastodon-profile.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-search.el b/elpa/mastodon-20251201.1553/mastodon-search.el deleted file mode 100644 index dda71765..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-search.el +++ /dev/null @@ -1,390 +0,0 @@ -;;; mastodon-search.el --- Search functions for mastodon.el -*- lexical-binding: t -*- - -;; Copyright (C) 2017-2019 Marty Hiatt -;; Author: Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; 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 "" .url "\n" .title) - link) - 'item-type 'link - 'item-json link - 'shr-url .url - 'byline t ;; nav - 'help-echo - (substitute-command-keys - "\\[`mastodon-search-load-link-posts'] to view a link's timeline")) - ;; TODO: display card link author here - "\n\n"))) - -(defun mastodon-search-load-link-posts () - "Load timeline of posts containing link at point." - (interactive) - (let* ((url (mastodon-tl--property 'shr-url))) - (mastodon-tl--link-timeline url))) - -(defun mastodon-search--view-trending (type print-fun) - "Display a list of tags trending on your instance. -TYPE is a string, either tags, statuses, or links. -PRINT-FUN is the function used to print the data from the response." - (let* ((url (mastodon-http--api (format "trends/%s" type))) - ;; max for statuses = 40, for others = 20 - (limit (if (string= type "statuses") - '("limit" . "40") - '("limit" . "20"))) - (offset '(("offset" . "0"))) - (params (push limit offset)) - (data (mastodon-http--get-json url params)) - (buffer (get-buffer-create - (format "*mastodon-trending-%s*" type)))) - (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-tl--set-buffer-spec (buffer-name buffer) - (format "trends/%s" type) - print-fun nil params) - (mastodon-search--insert-heading "trending" type) - (funcall print-fun data) - (unless (string= type "statuses") - (goto-char (point-min)))))) - -;; functions for mastodon search - -(defun mastodon-search--insert-heading (str &optional type) - "Insert STR as a heading. -Optionally add string TYPE after HEADING." - (insert - (mastodon-search--format-heading str type))) - -(defun mastodon-search--format-heading (str &optional type no-newline) - "Format STR as a heading. -Optionally add string TYPE after HEADING. -NO-NEWLINE means don't add add a newline at end." - (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n " - (upcase str) " " - (when type (upcase type)) "\n" - " " mastodon-tl--horiz-bar (unless no-newline "\n")) - 'success)) - -(defvar mastodon-search-types - '("statuses" "accounts" "hashtags")) - -(defun mastodon-search-query (query &optional type limit - following account-id offset) - "Prompt for a search QUERY and return accounts, statuses, and hashtags. -TYPE is a member of `mastodon-search-types'. -LIMIT is a number as string, up to 40, with 40 the default. -FOLLOWING means limit to accounts followed, for \"accounts\" type only. -A single prefix arg also sets FOLLOWING to true. -ACCOUNT-ID means limit search to that account, for \"statuses\" type only. -OFFSET is a number as string, means to skip that many results. It -is used for pagination." - ;; TODO: handle no results - (interactive "sSearch mastodon for: ") - (let* ((url (mastodon-http--api-v2 "search")) - (following (when (or following (equal current-prefix-arg '(4))) - "true")) - (type (or type - (if (equal current-prefix-arg '(4)) - "accounts" ; if FOLLOWING, must be "accounts" - (completing-read "Search type: " - mastodon-search-types nil :match)))) - (limit (or limit "40")) - (offset (or offset "0")) - (buffer (format "*mastodon-search-%s-%s*" type query)) - (params `(("q" . ,query) - ,@(when type `(("type" . ,type))) - ,@(when limit `(("limit" . ,limit))) - ,@(when offset `(("offset" . ,offset))) - ,@(when following `(("following" . ,following))) - ,@(when account-id `(("account_id" . ,account-id))))) - (response (mastodon-http--get-json url params)) - (items (alist-get (intern type) response))) - (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-search-mode) - (mastodon-search--insert-heading "search") - (mastodon-widget--create - "Results" - '(accounts hashtags statuses) - (intern type) - (lambda (widget &rest _ignore) - (let ((value (widget-value widget))) - (mastodon-search-query query (symbol-name value))))) - (insert "\n\n") - (cond ((string= type "accounts") - (mastodon-search--render-response items type buffer params - 'mastodon-views--insert-users-propertized-note - 'mastodon-views--insert-users-propertized-note)) - ((string= type "hashtags") - (mastodon-search--render-response items type buffer params - 'mastodon-search--print-tags - 'mastodon-search--print-tags)) - ((string= type "statuses") - (mastodon-search--render-response items type buffer params - #'mastodon-tl--timeline - #'mastodon-tl--timeline))) - (goto-char (point-min)) - (message - (substitute-command-keys - "\\[mastodon-search-query-cycle] to cycle result types."))))) - -(defun mastodon-search-insert-no-results (&optional thing) - "Insert a no results message for object THING." - (let ((thing (or thing "items"))) - (insert - (propertize (format "Looks like search returned no %s." thing) - 'face 'mastodon-toot-docs-face)))) - -(defun mastodon-search--render-response (data type buffer params - insert-fun update-fun) - "Call INSERT-FUN on DATA of result TYPE if non-nil. -BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'." - (if (not data) - (mastodon-search-insert-no-results type) - (funcall insert-fun data)) - (mastodon-tl--set-buffer-spec buffer "search" - update-fun nil params)) - -(defun mastodon-search--buf-type () - "Return search buffer type, a member of `mastodon-search-types'." - ;; called in `mastodon-tl--get-buffer-type' - (let* ((spec (mastodon-tl--buffer-property 'update-params))) - (alist-get "type" spec nil nil #'string=))) - -(defun mastodon-search-query-cycle () - "Cycle through search types: accounts, hashtags, and statuses." - (interactive) - (let* ((spec (mastodon-tl--buffer-property 'update-params)) - (type (alist-get "type" spec nil nil #'string=)) - (query (alist-get "q" spec nil nil #'string=))) - (cond ((string= type "hashtags") - (mastodon-search-query query "accounts")) - ((string= type "accounts") - (mastodon-search-query query "statuses")) - ((string= type "statuses") - (mastodon-search-query query "hashtags"))))) - -(defun mastodon-search-query-accounts-followed (query) - "Run an accounts search QUERY, limited to your followers." - (interactive "sSearch mastodon for: ") - (mastodon-search-query query "accounts" :following)) - -(defun mastodon-search--insert-users-propertized (json &optional note) - "Insert users list into the buffer. -JSON is the data from the server. -If NOTE is non-nil, include user's profile note. This is also - called by `mastodon-tl--get-follow-suggestions' and - `mastodon-profile--insert-follow-requests'." - (cl-loop for acct in json - do (insert (concat (mastodon-search--propertize-user acct note) - mastodon-tl--horiz-bar - "\n\n")))) - -(defun mastodon-search--propertize-user (acct &optional note) - "Propertize display string for ACCT, optionally including profile NOTE." - (let* ((user (mastodon-search--get-user-info acct)) - (id (alist-get 'id acct))) - (propertize - (concat - (propertize (car user) - 'face 'mastodon-display-name-face - 'byline t - 'item-type 'user - 'item-id id) ; for prev/next nav - " : \n : " - (propertize (concat "@" (cadr user)) - 'face 'mastodon-handle-face - 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle - 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" (cadr user)) - 'help-echo (concat "Browse user profile of @" (cadr user))) - " : \n" - (when note - (mastodon-tl--render-text (cadddr user) acct)) - "\n") - 'item-json acct))) ; for compat w other processing functions - -(defun mastodon-search--print-tags (tags) - "Print TAGS data as returned from a \"hashtags\" search query." - (let ((tags-list (mapcar #'mastodon-search--get-hashtag-info tags))) - (mastodon-search--print-tags-list tags-list))) - -(defun mastodon-search--print-tags-list (tags-list) - "Insert a propertized list of TAGS-LIST." - (cl-loop for el in tags-list - do (insert - " : " - (propertize (concat "#" (car el)) - 'face '(:box t) - 'mouse-face 'highlight - 'mastodon-tag (car el) - 'mastodon-tab-stop 'hashtag - 'item-type 'tag ; for next/prev nav - 'byline t ; for next/prev nav - 'help-echo (concat "Browse tag #" (car el)) - 'keymap mastodon-tl--link-keymap) - " : \n\n"))) - -(defun mastodon-search--get-user-info (account) - "Get user handle, display name, account URL and profile note from ACCOUNT." - (list (mastodon-tl--display-or-uname account) - (alist-get 'acct account) - (alist-get 'url account) - (alist-get 'note account))) - -(defun mastodon-search--get-hashtag-info (tag) - "Get hashtag name and URL from TAG." - (list (alist-get 'name tag) - (alist-get 'url tag))) - -;; These functions are all unused! - -;; (defun mastodon-search--get-status-info (status) -;; "Get ID, timestamp, content, and spoiler from STATUS." -;; (list (alist-get 'id status) -;; (alist-get 'created_at status) -;; (alist-get 'spoiler_text status) -;; (alist-get 'content status))) - -;; (defun mastodon-search--id-from-status (status) -;; "Fetch the id from a STATUS returned by a search call to the server. -;; We use this to fetch the complete status from the server." -;; (alist-get 'id status)) - -;; (defun mastodon-search--full-status-from-id (id) -;; "Fetch the full status with id ID from the server. -;; This allows us to access the full account etc. details and to -;; render them properly." -;; (let* ((url (mastodon-http--api (format "statuses/%s" id))) -;; ;; (concat mastodon-instance-url "/api/v1/statuses/" -;; ;; (mastodon-tl--as-string id))) -;; (json (mastodon-http--get-json url))) -;; json)) - -(defvar mastodon-search-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") #'mastodon-search-query-cycle) - map) - "Keymap for `mastodon-search-mode'.") - -(define-minor-mode mastodon-search-mode - "Toggle mastodon search minor mode. -This minor mode is used for mastodon search pages to adds a keybinding." - :init-value nil - :lighter " Search" - :keymap mastodon-search-mode-map - :group 'mastodon - :global nil) - -(provide 'mastodon-search) -;;; mastodon-search.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-tl.el b/elpa/mastodon-20251201.1553/mastodon-tl.el deleted file mode 100644 index 87b6f5a5..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-tl.el +++ /dev/null @@ -1,3950 +0,0 @@ -;;; 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 -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-tl.el provides timeline functions. - -;;; Code: - -(require 'shr) -(require 'thingatpt) ; for word-at-point -(require 'time-date) -(require 'cl-lib) -(require 'mastodon-iso) -(require 'mpv nil :no-error) -(require 'url-cache) - -(autoload 'mastodon-mode "mastodon") -(autoload 'mastodon-notifications-get "mastodon") -(autoload 'mastodon-url-lookup "mastodon") -(autoload 'mastodon-auth--get-account-id "mastodon-auth") -(autoload 'mastodon-auth--get-account-name "mastodon-auth") -(autoload 'mastodon-http--api "mastodon-http") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--build-params-string "mastodon-http") -(autoload 'mastodon-http--delete "mastodon-http") -(autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-http--get-json-async "mastodon-http") -(autoload 'mastodon-http--get-response-async "mastodon-http") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--process-json "mastodon-http") -(autoload 'mastodon-http--put "mastodon-http") -(autoload 'mastodon-http--triage "mastodon-http") -(autoload 'mastodon-media--get-avatar-rendering "mastodon-media") -(autoload 'mastodon-media--get-media-link-rendering "mastodon-media") -(autoload 'mastodon-media--inline-images "mastodon-media") -(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") -(autoload 'mastodon-notifications-get-mentions "mastodon-notifications") -(autoload 'mastodon-profile--account-from-id "mastodon-profile") -(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") -(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") -(autoload 'mastodon-profile-get-toot-author "mastodon-profile") -(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") -(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") -(autoload 'mastodon-profile-my-profile "mastodon-profile") -(autoload 'mastodon-profile-open-statuses-no-reblogs "mastodon-profile") -(autoload 'mastodon-profile--profile-json "mastodon-profile") -(autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") -(autoload 'mastodon-profile--item-json "mastodon-profile") -(autoload 'mastodon-profile--view-author-profile "mastodon-profile") -(autoload 'mastodon-profile-mode "mastodon-profile") -(autoload 'mastodon-search--get-user-info "mastodon-search") -(autoload 'mastodon-search--insert-users-propertized "mastodon-search") -(autoload 'mastodon-search--propertize-user "mastodon-search") -(autoload 'mastodon-toot--compose-buffer "mastodon-toot") -(autoload 'mastodon-toot-delete-toot "mastodon-toot") -(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") -(autoload 'mastodon-toot--iso-to-human "mastodon-toot") -(autoload 'mastodon-toot-schedule-toot "mastodon-toot") -(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") -(autoload 'mastodon-toot--update-status-fields "mastodon-toot") -(autoload 'mastodon-search--buf-type "mastodon-search") -(autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ; for search pagination -(autoload 'mastodon-http--get-response "mastodon-http") -(autoload 'mastodon-search--insert-heading "mastodon-search") -(autoload 'mastodon-media--process-full-sized-image-response "mastodon-media") -(autoload 'mastodon-search-trending-statuses "mastodon-search") -(autoload 'mastodon-search--format-heading "mastodon-search") -(autoload 'mastodon-media--image-or-cached "mastodon-media") -(autoload 'mastodon-toot--base-toot-or-item-json "mastodon-toot") -(autoload 'mastodon-search-load-link-posts "mastodon-search") -(autoload 'mastodon-notifications--current-type "mastodon-notifications") -(autoload 'mastodon-notifications--timeline "mastodon-notifications") -(autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications") -(autoload 'mastodon-search--print-tags "mastodon-search") -(autoload 'mastodon-profile-show-user "mastodon-profile") - -(defvar mastodon-toot--visibility) -(defvar mastodon-toot-mode) -(defvar mastodon-active-user) -(defvar mastodon-images-in-notifs) -(defvar mastodon-group-notifications) - -(when (require 'mpv nil :no-error) - (declare-function mpv-start "mpv")) -(defvar mastodon-mode-map) -(defvar mastodon-instance-url) -(defvar mastodon-toot-timestamp-format) -(defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this -(defvar mastodon-media--enable-image-caching) -(defvar mastodon-media--generic-broken-image-data) -(defvar mastodon-media--sensitive-image-data) -(defvar mastodon-media--attachments) - - -;;; CUSTOMIZES - -(defgroup mastodon-tl nil - "Timelines in Mastodon." - :prefix "mastodon-tl-" - :group 'mastodon) - -(defcustom mastodon-tl--enable-relative-timestamps t - "Whether to show relative (to the current time) timestamps. -This will require periodic updates of a timeline buffer to -keep the timestamps current as time progresses." - :type '(boolean :tag "Enable relative timestamps and background updater task")) - -(defcustom mastodon-tl--enable-proportional-fonts nil - "Nonnil to enable using proportional fonts when rendering HTML. -By default fixed width fonts are used." - :type '(boolean :tag "Enable using proportional rather than fixed \ -width fonts when rendering HTML text")) - -(defcustom mastodon-tl--no-fill-on-render nil - "Non-nil to disable filling by shr.el while rendering toot body. -Use this if your setup isn't compatible with shr's window width filling." - :type '(boolean)) - -(defcustom mastodon-tl--display-media-p t - "A boolean value stating whether to show media in timelines." - :type 'boolean) - -(defcustom mastodon-tl--display-caption-not-url-when-no-media t - "Display an image's caption rather than URL. -Only has an effect when `mastodon-tl--display-media-p' is set to -nil." - :type 'boolean) - -(defcustom mastodon-tl--show-avatars nil - "Whether to enable display of user avatars in timelines." - :type '(boolean :tag "Whether to display user avatars in timelines")) - -(defcustom mastodon-tl--show-stats t - "Whether to show toot stats (faves, boosts, replies counts)." - :type 'boolean) - -(defcustom mastodon-tl--symbols - `((reply . ("💬" . "R")) - (boost . ("🔁" . "B")) - (reblog . ("🔁" . "B")) ;; server compat - (favourite . ("⭐" . "F")) - (bookmark . ("🔖" . "K")) - (media . ("📹" . "[media]")) - (verified . ("✓" . "V")) - (locked . ("🔒" . "[locked]")) - (private . ("🔒" . "[followers]")) - (mention . ("@" . "[mention]")) - (direct . ("✉" . "[direct]")) - (edited . ("✍" . "[edited]")) - (update . ("✍" . "[edited]")) ;; server compat - (status . ("🔔" . "[posted]")) - (replied . ("⬇" . "↓")) - (reply-bar . ("┃" . "|")) - (poll . ("📊" . "[poll]")) - (follow . ("👤" . "+")) - (follow_request . ("👤" . "+")) - (severed_relationships . ("🔗" . "//")) - (moderation_warning . ("⚠" . "!!")) - (quote . (,(propertize "“" 'face - '(t :inherit success :weight bold - :height 1.8)))) - (quoted_update . ("✍" . "[edited]"))) - "A set of symbols (and fallback strings) to be used in timeline. -If a symbol does not look right (tofu), it means your -font settings do not support it." - :type '(alist :key-type symbol :value-type (cons string string))) - -(defcustom mastodon-tl-position-after-update nil - "Defines where `point' should be located after a timeline update. -Valid values are: -- nil Top/bottom depending on timeline type -- keep-point Keep original position of point -- last-old-toot The last toot before the new ones" - :type '(choice (const :tag "Top/bottom depending on timeline type" nil) - (const :tag "Keep original position of point" keep-point) - (const :tag "The last toot before the new ones" last-old-toot))) - -(defcustom mastodon-tl--timeline-posts-count "20" - "Number of posts to display when loading a timeline. -Must be an integer between 20 and 40 inclusive." - :type '(string)) - -(defcustom mastodon-tl--hide-replies nil - "Whether to hide replies from the timelines. -Note that you can hide replies on a one-off basis by loading a -timeline with a simple prefix argument, `C-u'." - :type '(boolean :tag "Whether to hide replies from the timelines.")) - -(defcustom mastodon-tl--highlight-current-toot nil - "Whether to highlight the toot at point. Uses `cursor-face' special property." - :type '(boolean)) - -(defcustom mastodon-tl--expand-content-warnings 'server - "Whether to expand content warnings by default. -The API returns data about this setting on the server, but no -means to set it, so we roll our own option here to override the -server setting if desired. If you change the server setting and -want it to be respected by mastodon.el, you'll likely need to -either unset `mastodon-profile-acccount-preferences-data' and -re-load mastodon.el, or restart Emacs." - :type '(choice (const :tag "true" t) - (const :tag "false" nil) - (const :tag "follow server setting" server))) - -(defcustom mastodon-tl--tag-timeline-tags nil - "A list of up to four tags for use with `mastodon-tl-followed-tags-timeline'." - :type '(repeat string)) - -(defcustom mastodon-tl--load-full-sized-images-in-emacs t - "Whether to load full-sized images inside Emacs. -Full-sized images are loaded when you hit return on or click on -an image in a timeline. -If nil, mastodon.el will instead call `shr-browse-image', which -respects the user's `browse-url' settings." - :type '(boolean)) - -(defcustom mastodon-tl--remote-local-domains nil - "A list of domains to view the local timelines of. -See `mastodon-tl-get-remote-local-timeline' for view remote local domains." - :type '(repeat string)) - -(defcustom mastodon-tl--fold-toots-at-length 1200 - "Length, in characters, to fold a toot at. -Longer toots will be folded and the remainder replaced by a -\"read more\" button. If the value is nil, don't fold at all." - :type '(integer)) - - -;;; 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 ?―) ?― ?-))) - - -;;; 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 "") #'mastodon-tl-mpv-play-video-at-point) - (define-key map (kbd "") #'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 "") #'mastodon-tl-mpv-play-video-from-byline) - (define-key map (kbd "RET") #'mastodon-profile-get-toot-author) - (define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image) - map)) - "The keymap to be set for the author byline. -It is active where point is placed by `mastodon-tl-goto-next-item.'") - -(require 'image-mode) - -(defvar mastodon-image-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map image-mode-map) - (define-key map (kbd ">") #'mastodon-tl-next-full-image) - (define-key map (kbd "<") #'mastodon-tl-prev-full-image) - (define-key map (kbd ".") #'mastodon-tl-next-full-image) - (define-key map (kbd ",") #'mastodon-tl-prev-full-image) - ;; matches view full image binding in main keymap: - (define-key map (kbd "=") #'mastodon-tl-next-full-image) - (define-key map (kbd "-") #'mastodon-tl-prev-full-image) - (define-key map (kbd "") #'mastodon-tl-next-full-image) - (define-key map (kbd "") #'mastodon-tl-prev-full-image) - map)) - - -;;; 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)) - - -;;; NAV - -(defun mastodon-tl-scroll-up-command () - "Call `scroll-up-command', loading more toots if necessary. -If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'." - (interactive) - (if (not (eq (point) (point-max))) - (scroll-up-command) - (mastodon-tl--more) - (scroll-up-command))) - -(defun mastodon-tl-next-tab-item (&optional previous) - "Move to the next interesting item. -This could be the next toot, link, or image; whichever comes first. -Don't move if nothing to move to is found, i.e. near the end of the buffer. -This also skips tab items in invisible text, i.e. hidden spoiler text. -PREVIOUS means move to previous item." - (interactive) - (let (next-range - (search-pos (point))) - (while (and (setq next-range - (mastodon-tl--find-next-or-previous-property-range - 'mastodon-tab-stop search-pos previous)) - (get-text-property (car next-range) 'invisible) - (setq search-pos (if previous - (1- (car next-range)) - (1+ (cdr next-range))))) - ;; do nothing, all the action is in the while condition - ) - (if (null next-range) - (user-error "Nothing else here") - (goto-char (car next-range)) - (message "%s" (mastodon-tl--property 'help-echo :no-move))))) - -(defun mastodon-tl-previous-tab-item () - "Move to the previous interesting item. -This could be the previous toot, link, or image; whichever comes -first. Don't move if nothing else to move to is found, i.e. near -the start of the buffer. This also skips tab items in invisible -text, i.e. hidden spoiler text." - (interactive) - (mastodon-tl-next-tab-item :previous)) - -(defun mastodon-tl--goto-item-pos (find-pos refresh &optional pos) - "Search for item with function FIND-POS. -If search returns nil, execute REFRESH function. -Optionally start from POS." - (let* ((npos ; toot/user items have byline: - (funcall find-pos - (or pos - (if (save-excursion - (when (not (= 1 (point))) - (backward-char 1)) - (looking-at "\u2068")) - (1- (point)) - (point))) - ;; FIXME: we need to fix item-type? - ;; 'item-type ; breaks nav to last item in a view? - 'byline - (current-buffer))) - (max-lisp-eval-depth 4)) ;; clamp down on endless loops - (if npos - (if (not (get-text-property npos 'item-type)) ; generic - ;; FIXME let's make refresh &optional and only call refresh/recur - ;; if non-nil: - (mastodon-tl--goto-item-pos find-pos refresh npos) - (goto-char npos) - ;; force display of help-echo on moving to a toot byline: - (mastodon-tl--message-help-echo) - (when (looking-at "\u2068") - (forward-char 1))) - (condition-case nil - (funcall refresh) - (error "No more items"))))) - -(defun mastodon-tl-goto-next-item (&optional no-refresh) - "Jump to next item. -Load more items it no next item. -NO-REFRESH means do no not try to load more items if no next item -found." - (interactive) - (condition-case nil - (mastodon-tl--goto-item-pos 'next-single-property-change - (unless no-refresh 'mastodon-tl--more)) - (t (error "No more items")))) - -(defun mastodon-tl-goto-prev-item (&optional no-refresh) - "Jump to previous item. -Update if no previous items. -NO-REFRESH means do no not try to load more items if no next item -found." - (interactive) - (condition-case nil - (mastodon-tl--goto-item-pos 'previous-single-property-change - (unless no-refresh 'mastodon-tl-update)) - (t (error "No more items")))) - -(defun mastodon-tl--goto-first-item () - "Jump to first toot or item in buffer. -Used on initializing a timeline or thread." - (goto-char (point-min)) - (condition-case nil - (mastodon-tl--goto-item-pos 'next-single-property-change - 'next-line) - (t (error "No item")))) - - -;;; TIMELINES - -(defun mastodon-tl-get-federated-timeline (&optional prefix local max-id) - "Open federated timeline. -If LOCAL, get only local timeline. -With a single PREFIX arg, hide-replies. -With a double PREFIX arg, only show posts with media." - (interactive "p") - (let ((params - `(("limit" . ,mastodon-tl--timeline-posts-count) - ,@(when (eq prefix 16) - '(("only_media" . "true"))) - ,@(when local - '(("local" . "true"))) - ,@(when max-id - `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))) - (message "Loading federated timeline...") - (mastodon-tl--init (if local "local" "federated") - "timelines/public" 'mastodon-tl--timeline nil - params - (when (eq prefix 4) t)))) - -(defun mastodon-tl-get-home-timeline (&optional arg max-id) - "Open home timeline. -With a single prefix ARG, hide replies. -MAX-ID is a flag to add the max_id pagination parameter." - (interactive "p") - (let* ((params - `(("limit" . ,mastodon-tl--timeline-posts-count) - ,@(when max-id - `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))) - (message "Loading home timeline...") - (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil - params - (when (eq arg 4) t)))) - -(defun mastodon-tl-get-remote-local-timeline (&optional endpoint) - "Prompt for an instance domain and try to display its local timeline. -You can enter any working instance domain. Domains that you want -to regularly load can be stored in -`mastodon-tl--remote-local-domains' for easy access with completion. -Note that some instances do not make their local timelines public, in -which case this will not work. -To interact with any item, you must view it from your own -instance, which you can do with -`mastodon-tl-view-item-on-own-instance'. -Optionally, provide API ENDPOINT." - (interactive) - (let* ((domain (completing-read "Domain for remote local tl: " - mastodon-tl--remote-local-domains)) - (params `(("limit" . ,mastodon-tl--timeline-posts-count) - ("local" . "true"))) - (buf (concat "remote-local-" domain)) - (known (member domain - (mastodon-http--get-json - (mastodon-http--api "instance/peers"))))) - ;; condition-case doesn't work here, so i added basic error handling to - ;; `mastodon-tl--init*' instead - (when (or known - (y-or-n-p - "Domain appears unknown to your instance. Proceed?")) - (mastodon-tl--init buf - (or endpoint "timelines/public") - 'mastodon-tl--timeline nil - params nil domain)))) - -(defun mastodon-tl-remote-tag-timeline (&optional tag) - "Call `mastodon-tl-get-remote-local-timeline' but for a TAG timeline." - (interactive) - (let* ((tag (or tag (read-string "Tag: "))) - (endpoint (format "timelines/tag/%s" tag))) - (mastodon-tl-get-remote-local-timeline endpoint))) - -(defun mastodon-tl-view-item-on-own-instance () - "Load current toot on your own instance. -Use this to re-load remote-local items in order to interact with them." - (interactive) - (mastodon-tl--do-if-item - (let* ((toot (mastodon-tl--property 'item-json)) - (uri (mastodon-tl--field 'uri toot))) - (mastodon-url-lookup uri)))) - -(defun mastodon-tl-get-local-timeline (&optional prefix max-id) - "Open local timeline. -With a single PREFIX arg, hide-replies. -With a double PREFIX arg, only show posts with media. -MAX-ID is a flag to add the max_id pagination parameter." - (interactive "p") - (message "Loading local timeline...") - (mastodon-tl-get-federated-timeline prefix :local max-id)) - -(defun mastodon-tl-get-tag-timeline (&optional prefix tag) - "Prompt for tag and opens its timeline. -Optionally load TAG timeline directly. -With a single PREFIX arg, only show posts with media. -With a double PREFIX arg, limit results to your own instance." - (interactive "p") - (let* ((word (or (word-at-point) "")) - (input (or tag (read-string - (format "Load timeline for tag (%s): " word)))) - (tag (or tag (if (string-empty-p input) word input)))) - (message "Loading timeline for #%s..." tag) - (mastodon-tl--show-tag-timeline prefix tag))) - -(defun mastodon-tl--show-tag-timeline (&optional prefix tag) - "Opens a new buffer showing the timeline of posts with hastag TAG. -If TAG is a list, show a timeline for all tags. -With a single PREFIX arg, only show posts with media. -With a double PREFIX arg, limit results to your own instance." - (let ((params - `(("limit" . ,mastodon-tl--timeline-posts-count) - ,@(when (eq prefix 4) - '(("only_media" . "true"))) - ,@(when (eq prefix 16) - '(("local" . "true")))))) - (when (listp tag) - (let ((list (mastodon-http--build-array-params-alist "any[]" (cdr tag)))) - (while list - (push (pop list) params)))) - (mastodon-tl--init - (if (listp tag) "tags-multiple" (concat "tag-" tag)) - (concat "timelines/tag/" (if (listp tag) (car tag) tag)) ; must be /tag/:sth - 'mastodon-tl--timeline nil params))) - -(defun mastodon-tl--link-timeline (url) - "Load a link timeline, displaying posts containing URL." - (let ((params `(("url" . ,url)))) - (mastodon-tl--init "links" "timelines/link" - 'mastodon-tl--timeline nil - params))) - -(defun mastodon-tl-announcements () - "Display announcements from your instance." - (interactive) - (mastodon-tl--init "announcements" "announcements" - 'mastodon-tl--timeline nil nil nil nil :no-byline)) - - -;;; BYLINES, etc. - -(defun mastodon-tl--message-help-echo () - "Call message on `help-echo' property at point. -Do so if type of status at poins is not follow_request/follow." - (let ((type (alist-get 'type - (mastodon-tl--property 'item-json :no-move))) - (echo (mastodon-tl--property 'help-echo :no-move))) - (when (not (string= "" echo)) ; not for followers/following in profile - (unless (or (string= type "follow_request") - (string= type "follow")) ; no counts for these - (message "%s" echo))))) - -(defun mastodon-tl--unicode-wrap (str) - "Wrap STR in unicode directional isolates." - ;; see https://unicode.org/reports/tr9/#Explicit_Directional_Isolates - ;; via Tusky (again! thanks) - ;; https://codeberg.org/tusky/Tusky/src/commit/16cef3d6202648e4fd67f06ef0fb1d0a2d04b68f/app/src/main/java/com/keylesspalace/tusky/util/StringUtils.kt#L65 - (concat "\u2068" str "\u2069")) - -(defun mastodon-tl--byline-username (toot) - "Format a byline username from account in TOOT. -TOOT may be account data, or toot data, in which case acount data -is extracted from it." - (let ((data (or (alist-get 'account toot) - toot))) ;; grouped nofifs use account data directly - (let-alist data - (let ((disp (if (and .display_name - (not (string-empty-p .display_name))) - (mastodon-tl--unicode-wrap .display_name) - .username))) - (propertize disp - 'face 'mastodon-display-name-face - ;; enable playing of videos when point is on byline: - ;; 'attachments (mastodon-tl--get-attachments-for-byline toot) - 'keymap mastodon-tl--byline-link-keymap - ;; echo faves count when point on post author name: - ;; which is where --goto-next-toot puts point. - 'help-echo - ;; but don't add it to "following"/"follows" on - ;; profile views: we don't have a tl--buffer-spec - ;; yet: - (unless (or (string-suffix-p "-followers*" (buffer-name)) - (string-suffix-p "-following*" (buffer-name))) - (mastodon-tl--format-byline-help-echo data))))))) - -(defun mastodon-tl--byline-handle (toot &optional domain string face) - "Format a byline handle from account in TOOT. -DOMAIN is optionally added to the handle. -ACCOUNT is optionally acccount data to use. -STRING is optionally the string to propertize, it is used to make -username rather than handle buttons. -FACE is optionally the face to use. -The last two args allow for display a username as a clickable -handle." - (let-alist (or (alist-get 'account toot) - toot) ;; grouped notifs - (let ((str (or string - (concat "@" .acct - (when domain - (concat "@" - (url-host - (url-generic-parse-url .url)))))))) - (mastodon-tl--buttonify-link - (mastodon-tl--unicode-wrap str) - 'face (or face 'mastodon-handle-face) - 'mastodon-tab-stop 'user-handle - 'shr-url .url - 'mastodon-handle (concat "@" .acct) - 'help-echo (concat "Browse user profile of @" .acct))))) - -(defun mastodon-tl--byline-uname-+-handle (data &optional domain) - "Concatenate a byline username and handle. -DATA is the (toot) data to use. -DOMAIN is optionally a domain for the handle. -ACCOUNT is optionally acccount data to use." - (concat (mastodon-tl--byline-username data) - " (" (mastodon-tl--byline-handle data domain) ")")) - -(defun mastodon-tl--display-or-uname (account) - "Return display name or username from ACCOUNT data." - (if (not (string-empty-p (alist-get 'display_name account))) - (alist-get 'display_name account) - (alist-get 'username account))) - -(defun mastodon-tl--byline-author (toot &optional avatar domain base) - "Propertize author of TOOT. -With arg AVATAR, include the account's avatar image. -When DOMAIN, force inclusion of user's domain in their handle. -BASE means to use data from the base item (reblog slot) if possible. -If BASE is nil, we are a boosted byline, so show less info. -ACCOUNT is optionally acccount data to use." - (let* ((data (if base - (mastodon-tl--toot-or-base toot) - toot)) - (account (alist-get 'account data)) - (uname (mastodon-tl--display-or-uname account))) - (concat - ;; avatar insertion moved up to `mastodon-tl--byline' by default to - ;; be outside 'byline propt. - (when (and avatar ; used by `mastodon-profile--format-user' - mastodon-tl--show-avatars - mastodon-tl--display-media-p - (mastodon-tl--image-trans-check)) - (mastodon-media--get-avatar-rendering - (map-nested-elt data '(account avatar)))) - (if (not base) - ;; boost symbol: - (concat (mastodon-tl--symbol 'boost) - " " - ;; username as button: - (mastodon-tl--byline-handle - data domain - ;; display uname not handle (for boosts): - uname 'mastodon-display-name-face)) - ;; normal combo author byline: - (mastodon-tl--byline-uname-+-handle data domain))))) - -(defun mastodon-tl--format-byline-help-echo (toot) - "Format a help-echo for byline of TOOT. -Displays a toot's media types and optionally the binding to play -moving image media from the byline. -Used when point is at the start of a byline, i.e. where -`mastodon-tl-goto-next-item' leaves point." - (let* ((toot-to-count - (or ; simply praying this order works - (alist-get 'status toot) ; notifications timeline - ;; fol-req notif, has 'type placed before boosts coz fol-reqs have - ;; a (useless) reblog entry: - (when (and (or (mastodon-tl--buffer-type-eq 'notifications) - (mastodon-tl--buffer-type-eq 'mentions)) - (alist-get 'type toot)) - toot) - (alist-get 'reblog toot) ; boosts - toot)) ; everything else - (fol-req-p (let ((type (alist-get 'type toot-to-count))) - (or (string= type "follow") - (string= type "follow_request"))))) - (unless fol-req-p - (let* ((media-types (mastodon-tl--get-media-types toot)) - (format-media (when media-types - (format "media: %s" - (mapconcat #'identity media-types " ")))) - (format-media-binding (when (and (or (member "video" media-types) - (member "gifv" media-types)) - (require 'mpv nil :no-error)) - " | C-RET to view with mpv"))) - (concat format-media format-media-binding))))) - -(defun mastodon-tl--get-media-types (toot) - "Return a list of the media attachment types of the TOOT at point." - (let* ((attachments (mastodon-tl--field 'media_attachments toot))) - (mastodon-tl--map-alist 'type attachments))) - -(defun mastodon-tl--get-attachments-for-byline (toot) - "Return a list of attachment URLs and types for TOOT. -The result is added as an attachments property to author-byline." - (let ((media (mastodon-tl--field 'media_attachments toot))) - (mapcar (lambda (attachment) - (let-alist attachment - (list :id .id - :type .type - ;; fallback for notifications: - :url (or .remote_url .url)))) - media))) - -(defun mastodon-tl--acc-by-id (id) - "Return account JSON for ID." - (let* ((endpoint (format "accounts/%s" id)) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url))) - -(defun mastodon-tl--top-byline (toot) - "Format a boost or reply top (action) byline for TOOT. -If it is a self-reply, return 'continued thread'. -If it is a non-self-reply, return 'in reply to $username'. -If it is a boost, return '$username boosted'." - (let ((reblog (alist-get 'reblog toot)) - (reply-acc-id (alist-get 'in_reply_to_account_id toot))) - (cond - (reblog - (concat (mastodon-tl--byline-author toot) " " - (propertize "boosted" 'face 'mastodon-boosted-face) "\n")) - (reply-acc-id - (unless (mastodon-tl--buffer-type-eq 'thread) - (if (equal reply-acc-id (map-nested-elt toot '(account id))) - (concat (mastodon-tl--symbol 'reply) " " - (mastodon-tl--buttonify-link - "continued thread\n" - 'face 'mastodon-boosted-face - 'continued-thread t - 'help-echo "Browse thread")) - (let* ((acc (mastodon-tl--acc-by-id reply-acc-id)) - (name (or (alist-get 'display_name acc) - (alist-get 'username acc)))) - (concat (mastodon-tl--symbol 'reply) - (mastodon-tl--buttonify-link - " in reply to " - 'face 'mastodon-boosted-face - 'continued-thread t - 'help-echo "Browse thread") - (propertize name - 'face 'mastodon-display-name-face) - "\n"))))) - (t "")))) - -(defun mastodon-tl-continued-thread-load () - "Load thread based on prop item-id. -Used to load self-reply threads by clicking on top-byline's \"continued -thead\" text." - (interactive) - (let ((id (mastodon-tl--property 'item-id))) - (mastodon-tl--thread-do id))) - -(defun mastodon-tl--format-faved-or-boosted-byline (letter) - "Format the byline marker for a boosted or favourited status. -LETTER is a string, F for favourited, B for boosted, or K for bookmarked." - (let ((help-string (cond ((string= letter "F") - "favourited") - ((string= letter "B") - "boosted") - ((string= letter (or "🔖" "K")) - "bookmarked")))) - (format "(%s) " - (propertize letter 'face 'mastodon-boost-fave-face - ;; emojify breaks this for 🔖: - 'help-echo (format "You have %s this status." - help-string))))) - -(defun mastodon-tl--image-trans-check () - "Call `image-transforms-p', or `image-type-available-p' imagemagick." - (if (version< emacs-version "27.1") - (image-type-available-p 'imagemagick) - (image-transforms-p))) - -(defun mastodon-tl--byline (toot &optional detailed-p - domain base-toot group ts) - "Generate (bottom) byline for TOOT. -AUTHOR-BYLINE is a function for adding the author portion of -the byline that takes one variable. -DETAILED-P means display more detailed info. For now -this just means displaying toot client. -When DOMAIN, force inclusion of user's domain in their handle. -BASE-TOOT is JSON for the base toot, if any. -GROUP is the notification group if any. -ACCOUNT is the notification account if any. -TS is a timestamp from the server, if any." - (let* ((type (alist-get 'type (or group toot))) - (created-time - (or ts ;; mentions, statuses, folls/foll-reqs - ;; bosts, faves, edits, polls in notifs view use base item - ;; timestamp: - (mastodon-tl--field 'created_at - (mastodon-tl--field 'status toot)) - ;; all other toots, inc. boosts/faves in timelines: - ;; (mastodon-tl--field auto fetches from reblogs if needed): - (mastodon-tl--field 'created_at toot))) - (parsed-time (when created-time (date-to-time created-time))) - ;; non-grouped notifs now need to pull the following data from - ;; base toot: - (base-maybe (or base-toot ;; show edits for notifs - (mastodon-tl--toot-or-base toot))) ;; for boosts - (faved (eq t (mastodon-tl--field 'favourited base-maybe))) - (boosted (eq t (mastodon-tl--field 'reblogged base-maybe))) - (bookmarked (eq t (mastodon-tl--field 'bookmarked base-maybe))) - (visibility (mastodon-tl--field 'visibility base-maybe)) - (account (alist-get 'account base-maybe)) - (avatar-url (alist-get 'avatar account)) - (edited-time (alist-get 'edited_at base-maybe)) - (edited-parsed (when edited-time (date-to-time edited-time)))) - (concat - ;; Boosted/favourited markers are not technically part of the byline, so - ;; we don't propertize them with 'byline t', as per the rest. This - ;; ensures that `mastodon-tl-goto-next-item' puts point on - ;; author-byline, not before the (F) or (B) marker. Not propertizing like - ;; this makes the behaviour of these markers consistent whether they are - ;; displayed for an already boosted/favourited toot or as the result of - ;; the toot having just been favourited/boosted. - (concat (when boosted - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'boost))) - (when faved - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'favourite))) - (when bookmarked - (mastodon-tl--format-faved-or-boosted-byline - (mastodon-tl--symbol 'bookmark)))) - ;; we remove avatars from the byline also, so that they also do not - ;; mess with `mastodon-tl-goto-next-item': - (when (and mastodon-tl--show-avatars - mastodon-tl--display-media-p - (mastodon-tl--image-trans-check)) - (mastodon-media--get-avatar-rendering avatar-url)) - (propertize - (concat - ;; NB: action-byline (boost) is now added in insert-status, so no - ;; longer part of the byline. - ;; (base) author byline: - ;; we use base-toot if poss for fave/boost notifs that need to show - ;; base item in author byline - (mastodon-tl--byline-author (or base-toot toot) - nil domain :base) - ;; visibility: - (cond ((string= visibility "direct") - (propertize (concat " " (mastodon-tl--symbol 'direct)) - 'help-echo visibility)) - ((string= visibility "private") - (propertize (concat " " (mastodon-tl--symbol 'private)) - 'help-echo visibility))) - " " - ;; timestamp: - (let ((ts (format-time-string - mastodon-toot-timestamp-format parsed-time))) - (propertize ts - 'timestamp parsed-time - 'display - (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description parsed-time) - parsed-time) - 'help-echo ts)) - ;; detailed: - (when detailed-p - (let* ((app-name (map-nested-elt toot '(application name))) - (app-url (map-nested-elt toot '(application website)))) - (when app-name - (concat - (propertize " via " 'face 'default) - (propertize app-name - 'face 'mastodon-display-name-face - 'follow-link t - 'mouse-face 'highlight - 'mastodon-tab-stop 'shr-url - 'shr-url app-url - 'help-echo app-url - 'keymap mastodon-tl--shr-map-replacement))))) - ;; edited: - (when edited-time - (concat - " " - (mastodon-tl--symbol 'edited) - " " - (propertize - (format-time-string mastodon-toot-timestamp-format - edited-parsed) - 'face 'mastodon-toot-docs-face - 'timestamp edited-parsed - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description edited-parsed) - edited-parsed)))) - (propertize (concat "\n " mastodon-tl--horiz-bar) - 'face 'default) - ;; stats: - (when (and mastodon-tl--show-stats - (not (member type '("follow" "follow_request")))) - (mastodon-tl--toot-stats toot)) - "\n") - 'favourited-p faved - 'boosted-p boosted - 'bookmarked-p bookmarked - ;; enable playing of videos when point is on byline: - 'attachments (mastodon-tl--get-attachments-for-byline toot) - 'edited edited-time - 'edit-history (when edited-time - (mastodon-toot--get-toot-edits - (alist-get 'id base-maybe))) - 'byline t)))) - - -;;; 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))) - - -;;; RENDERING HTML, LINKS, HASHTAGS, HANDLES - -(defun mastodon-tl--render-text (string &optional toot) - "Return a propertized text rendering the given HTML string STRING. -The contents comes from the given TOOT which is used in parsing -links in the text. If TOOT is nil no parsing occurs." - (when string ; handle rare empty notif server bug - (with-temp-buffer - (insert string) - (let ((shr-use-fonts mastodon-tl--enable-proportional-fonts) - (shr-width (when mastodon-tl--enable-proportional-fonts - (if mastodon-tl--no-fill-on-render - 0 - (- (window-width) 3)))) - (cat (get 'mastodon-tl-link 'button-category-symbol))) - (shr-render-region (point-min) (point-max)) - (alter-text-property - (point-min) (point-max) 'category - (lambda (type) (when type cat)))) - ;; Make all links a tab stop recognized by our own logic, make - ;; things point to our own logic (e.g. hashtags), and update keymaps - ;; where needed: - (when toot - (let (region) - (while (setq region (mastodon-tl--find-property-range - 'shr-url (or (cdr region) (point-min)))) - (mastodon-tl--process-link toot - (car region) (cdr region) - (get-text-property (car region) 'shr-url)) - (when (proper-list-p toot) ;; not on profile fields cons cells - ;; render card author maybe: - (let* ((card-url (map-nested-elt toot '(card url))) - (authors (map-nested-elt toot '(card authors))) - (url (buffer-substring (car region) (cdr region))) - (url-no-query (car (split-string url "?")))) - (when (and (string= url-no-query card-url) - ;; only if we have an account's data: - (alist-get 'account (car authors))) - (goto-char (point-max)) - (mastodon-tl--insert-card-authors authors))))))) - (buffer-string)))) - -(defun mastodon-tl--insert-card-authors (authors) - "Insert a string of card AUTHORS." - (let ((authors-str (format "Author%s: " - (if (< 1 (length authors)) "s" "")))) - (insert - (concat - "\n(" authors-str - (mapconcat #'mastodon-tl--format-card-author authors "\n") - ")\n")))) - -(defun mastodon-tl--format-card-author (data) - "Render card author DATA." - (when-let* ((account (alist-get 'account data))) ;.account - (let-alist account ;.account - ;; FIXME: replace with refactored handle render fun - ;; in byline refactor branch: - (concat - (propertize (mastodon-tl--unicode-wrap (or .display_name .username)) - 'face 'mastodon-display-name-face - 'item-type 'user - 'item-id .id) - " " - (propertize (concat "@" .acct) - 'face 'mastodon-handle-face - 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle - 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" .acct) - 'help-echo (concat "Browse user profile of @" .acct)))))) - -(defun mastodon-tl--process-link (toot start end url) - "Process link URL in TOOT as hashtag, userhandle, or normal link. -START and END are the boundaries of the link in the toot." - (let* (mastodon-tab-stop-type - keymap - (help-echo (get-text-property start 'help-echo)) - extra-properties - ;; handle calling this on non-toots, e.g. for profiles: - (toot-url (when (proper-list-p toot) - (mastodon-tl--field 'url toot))) - (toot-url (when toot-url (url-generic-parse-url toot-url))) - (toot-instance-url (if toot-url - (concat (url-type toot-url) "://" - (url-host toot-url)) - mastodon-instance-url)) - (link-str (buffer-substring-no-properties start end)) - (maybe-hashtag (mastodon-tl--hashtag-from-url - url toot-instance-url)) - (maybe-userhandle - (if (proper-list-p toot) ; fails for profile buffers? - (or (mastodon-tl--userhandle-from-mentions toot link-str) - (mastodon-tl--userhandle-from-url url link-str)) - (mastodon-tl--userhandle-from-url url link-str)))) - (cond (maybe-hashtag - (setq mastodon-tab-stop-type 'hashtag - keymap mastodon-tl--link-keymap - help-echo (concat "Browse tag #" maybe-hashtag) - extra-properties (list 'mastodon-tag maybe-hashtag))) - (maybe-userhandle ;; fails on mentions in profile notes: - (let ((maybe-userid (when (proper-list-p toot) - (mastodon-tl--extract-userid-toot - toot link-str)))) - (setq mastodon-tab-stop-type 'user-handle - keymap mastodon-tl--link-keymap - help-echo (concat "Browse user profile of " maybe-userhandle) - extra-properties (append - (list 'mastodon-handle maybe-userhandle) - (when maybe-userid - (list 'account-id maybe-userid)))))) - (t ;; Anything else (leave it as a url handled by shr.el): - (setq keymap (if (eq shr-map (get-text-property start 'keymap)) - mastodon-tl--shr-map-replacement - mastodon-tl--shr-image-map-replacement) - mastodon-tab-stop-type 'shr-url))) - (add-text-properties start end - (append - (list 'mastodon-tab-stop mastodon-tab-stop-type - 'keymap keymap - 'help-echo help-echo) - extra-properties)))) - -(defun mastodon-tl--userhandle-from-mentions (toot link) - "Extract a user handle from mentions in json TOOT. -LINK is maybe the `@handle' to search for." - (mastodon-tl--el-from-mentions 'acct toot link)) - -(defun mastodon-tl--extract-userid-toot (toot link) - "Extract a user id for an ACCT from mentions in a TOOT. -LINK is maybe the `@handle' to search for." - (mastodon-tl--el-from-mentions 'id toot link)) - -(defun mastodon-tl--el-from-mentions (el toot link) - "Extract element EL from TOOT mentions that matches LINK. -LINK should be a simple handle string with no domain, i.e. \"@user\". -Return nil if no matching element." - (let ((mentions (alist-get 'mentions toot))) - (when mentions - (let* ((mention (pop mentions)) - (name (substring-no-properties link 1 (length link))) ; cull @ - return) - (while mention - (when (string= name (alist-get 'username mention)) - (setq return (alist-get el mention))) - (setq mention (pop mentions))) - return)))) - -(defun mastodon-tl--userhandle-from-url (url &optional buffer-text) - "Return the user hande the URL points to or nil if it is not a profile link. -BUFFER-TEXT is the text covered by the link with URL, for a user profile -this should be of the form , e.g. \"@Gargon\". -This is called on all post URLs, so needs to handle non profile URLs -gracefully." - (let* ((parsed-url (url-generic-parse-url url)) - (host (url-host parsed-url)) - (local-p (string= - (url-host (url-generic-parse-url mastodon-instance-url)) - host)) - (path-raw (url-filename parsed-url))) - (unless (string-empty-p path-raw) - (let ((path (substring path-raw 1))) ;; remove "/" prefix - (if (not buffer-text) - (when (string-prefix-p "@" path) - (if local-p path (concat "@" host))) - (when (and (string= "@" (substring buffer-text 0 1)) - ;; don't error on domain only url (rare): - (string= (downcase buffer-text) - (downcase path))) - (if local-p - buffer-text ; no instance suffix for local mention - (concat buffer-text "@" host)))))))) - -(defun mastodon-tl--hashtag-from-url (url instance-url) - "Return the hashtag that URL points to or nil if URL is not a tag link. -INSTANCE-URL is the url of the instance for the toot that the link -came from (tag links always point to a page on the instance publishing -the toot)." - ;; TODO: do we rly need to check it against instance-url? - ;; test suggests we might - (let* ((instance-host (url-host - (url-generic-parse-url instance-url))) - (parsed (url-generic-parse-url url)) - (path (url-filename parsed))) - (when (string= instance-host (url-host parsed)) - (cond ((string-prefix-p "/tag" path) ;; "/tag/" or "/tags/" - (let ((split (split-string path "/"))) - (nth 2 split))) - ((string-prefix-p "?t=" path) ;; snac tag - (let ((split (split-string path "="))) - (nth 1 split))))))) - -(defun mastodon-tl--base-tags (tags body-tags) - "Return a string of all tags not in BODY-TAGS, linkified. -TAGS is a list of tag alists, from a post's JSON." - (when (mastodon-tl--base-tags-print-p tags body-tags) - (concat - "\n" - (cl-loop for tag in tags - concat (concat (mastodon-tl--render-base-tag tag body-tags) - " "))))) - -(defun mastodon-tl--base-tags-print-p (tags body-tags) - "Non-nil if we need to print base tags. -We need to do so if TAGS contains any elements not in BODY-TAGS." - (cl-remove-if - (lambda (tag) - ;; downcase name string (body strings are downcased): - (member (downcase (alist-get 'name tag)) body-tags)) - tags)) - -(defun mastodon-tl--render-base-tag (tag body-tags) - "Return TAG as a linkified string, provided it is not in BODY-TAGS." - (let ((name (alist-get 'name tag))) - (unless (member (downcase name) body-tags) - (mastodon-tl--buttonify-link - (concat "#" name) - 'mastodon-tab-stop 'hashtag - 'mastodon-tag name - 'mouse-face '(highlight) - 'keymap mastodon-tl--link-keymap - 'face '(shr-text shr-link) - 'follow-link t - 'shr-tab-stop t - 'shr-url (alist-get 'url tag) - 'help-echo (concat "Browse tag #" name))))) - - -;;; HYPERLINKS - -(define-button-type 'mastodon-tl-link - 'action #'mastodon-tl--push-button - 'keymap mastodon-tl--link-keymap - 'mouse-face 'highlight) - -(defun mastodon-tl--push-button (button) - "Do the appropriate action for BUTTON." - (mastodon-tl-do-link-action-at-point (button-start button))) - -(defun mastodon-tl--buttonify-link (string &rest properties) - "Make STRING a `mastodon-tl-link' type button. -PROPERTIES are additional properties to attach to string." - (apply #'propertize string - 'button t - 'category (get 'mastodon-tl-link 'button-category-symbol) - properties)) - -(defun mastodon-tl--make-link (string link-type) - "Return a propertized version of STRING that will act like link. -LINK-TYPE is the type of link to produce." - (let ((help-text (cond ((eq link-type 'content-warning) - "Toggle hidden text") - ((or (eq link-type 'read-more) - (eq link-type 'read-less)) - "Toggle full post") - (t - (error "Unknown link type %s" link-type))))) - (mastodon-tl--buttonify-link string - 'mastodon-tab-stop link-type - 'help-echo help-text))) - -(defun mastodon-tl-do-link-action-at-point (pos) - "Do the action of the link at POS. -Used for hitting RET on a given link." - (interactive "d") - (let ((link-type (get-text-property pos 'mastodon-tab-stop)) - (cont-thread (mastodon-tl--property 'continued-thread :nomove))) - (cond (cont-thread - (mastodon-tl-continued-thread-load)) - ((eq link-type 'content-warning) - (mastodon-tl--toggle-spoiler-text pos)) - ((eq link-type 'hashtag) - (mastodon-tl--show-tag-timeline - nil (get-text-property pos 'mastodon-tag))) - ;; 'account / 'account-id is not set for mentions, only bylines - ((eq link-type 'user-handle) - (let ((account-json (get-text-property pos 'account)) - (account-id (get-text-property pos 'account-id))) - (cond - (account-json - (mastodon-profile--make-author-buffer account-json)) - (account-id - (mastodon-profile--make-author-buffer - (mastodon-profile--account-from-id account-id))) - (t - (let ((account (mastodon-profile--search-account-by-handle - (get-text-property pos 'mastodon-handle)))) - ;; never call make-author-buffer on nil account: - (cond (account - (mastodon-profile--make-author-buffer account)) - ;; optional webfinger lookup: - ((y-or-n-p - "Search for account returned nothing. Perform URL lookup?") - (mastodon-url-lookup (get-text-property pos 'shr-url))) - (t - (error "Unable to find account")))))))) - ((eq link-type 'shr-url) - (mastodon-url-lookup (get-text-property pos 'shr-url))) - ((eq link-type 'read-more) - (mastodon-tl-unfold-post)) - ((eq link-type 'read-less) - (mastodon-tl-fold-post)) - (t - (error "Unknown link type %s" link-type))))) - -(defun mastodon-tl-do-link-action (event) - "Do the action of the link at point. -Used for a mouse-click EVENT on a link." - (interactive "@e") - (mastodon-tl-do-link-action-at-point (posn-point (event-end event)))) - - -;;; CONTENT WARNINGS - -(defun mastodon-tl--has-spoiler (toot) - "Check if the given TOOT has a spoiler text. -Spoiler text should initially be shown only while the main -content should be hidden." - (let ((spoiler (mastodon-tl--field 'spoiler_text toot))) - (and spoiler (> (length spoiler) 0)))) - -(defun mastodon-tl--toggle-spoiler-text (position) - "Toggle the visibility of the spoiler text at/after POSITION." - (let* ((inhibit-read-only t) - (spoiler-region (mastodon-tl--find-property-range - 'mastodon-content-warning-body position nil)) - (new-state (not (get-text-property (car spoiler-region) - 'invisible)))) - (if (not spoiler-region) - (user-error "No spoiler text here") - (add-text-properties (car spoiler-region) (cdr spoiler-region) - (list 'invisible new-state)) - new-state))) ;; return what we set invisibility to - -(defun mastodon-tl-toggle-spoiler-text-in-toot () - "Toggle the visibility of the spoiler text in the current toot." - (interactive) - (let* ((toot-range (or (mastodon-tl--find-property-range - 'item-json (point)) - (mastodon-tl--find-property-range - 'item-json (point) t))) - (spoiler-range (when toot-range - (mastodon-tl--find-property-range - 'mastodon-content-warning-body - (car toot-range))))) - (cond ((null toot-range) - (user-error "No toot here")) - ((or (null spoiler-range) - (> (car spoiler-range) (cdr toot-range))) - (user-error "No content warning text here")) - (t - (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) - -(defun mastodon-tl-toggle-spoiler-in-thread () - "Toggler content warning for all posts in current thread." - (interactive) - (let ((thread-p (eq (mastodon-tl--buffer-property 'update-function) - 'mastodon-tl--thread-do))) - (if (not thread-p) - (user-error "Not in a thread") - (save-excursion - (goto-char (point-min)) - (while (not (string= "No more items" ; improve this hack test! - (mastodon-tl-goto-next-item :no-refresh))) - (let* ((json (mastodon-tl--property 'item-json :no-move)) - (cw (alist-get 'spoiler_text json))) - (when (not (string= "" cw)) - (let ((new-state - (pcase - (mastodon-tl-toggle-spoiler-text-in-toot) - ('t 'folded) - ('nil 'unfolded)))) - (plist-put mastodon-tl--buffer-spec - 'thread-unfolded new-state))))))))) - -(defun mastodon-tl--spoiler (toot &optional filter) - "Render TOOT with spoiler message. -This assumes TOOT is a toot with a spoiler message. -The main body gets hidden and only the spoiler text and the -content warning message are displayed. The content warning -message is a link which unhides/hides the main body. -FILTER is a string to use as a filter warning spoiler instead." - (let* ((spoiler (mastodon-tl--field 'spoiler_text toot)) - (string (mastodon-tl--set-face - (mastodon-tl--clean-tabs-and-nl - (mastodon-tl--render-text spoiler toot)) - 'default)) - (message (concat " " mastodon-tl--horiz-bar "\n " - (mastodon-tl--make-link - (if filter - (concat "Filtered: " filter) - (concat "CW: " string)) - 'content-warning) - "\n " - mastodon-tl--horiz-bar "\n")) - (cw (mastodon-tl--set-face message 'mastodon-cw-face))) - (concat - cw - (propertize - (mastodon-tl--content toot) - 'invisible - (or filter ;; filters = invis - (let ((cust mastodon-tl--expand-content-warnings)) - (if (not (eq 'server cust)) - (not cust) ;; opp to setting - ;; respect server setting: - ;; If something goes wrong reading prefs, - ;; just return t so CWs fold by default. - (condition-case nil - (if (eq :json-false - (mastodon-profile--get-preferences-pref - 'reading:expand:spoilers)) - t - nil) - (error t))))) - 'mastodon-content-warning-body t)))) - - -;;; MEDIA - -(defun mastodon-tl--media (toot) - "Retrieve a media attachment link for TOOT if one exists. -Else return an empty string." - (let* ((attachments (mastodon-tl--field 'media_attachments toot)) - (sensitive (mastodon-tl--field 'sensitive toot)) - (media-string (mapconcat - (lambda (x) - (mastodon-tl--media-attachment x sensitive)) - attachments ""))) - (if (not (and mastodon-tl--display-media-p - (string-empty-p media-string))) - (concat "\n" media-string) - ""))) - -(defun mastodon-tl--media-attachment (attachment sensitive) - "Return a propertized string for ATTACHMENT. -SENSITIVE is a flag from the item's JSON data." - (let-alist attachment - (let ((display-str - (concat "Media:: " - (if (and mastodon-tl--display-caption-not-url-when-no-media - .description) - .description - .preview_url))) - (remote-url (or .remote_url .url))) - (if (and mastodon-tl--display-media-p - ;; if in notifs, also check notifs images custom: - (if (or (mastodon-tl--buffer-type-eq 'notifications) - (mastodon-tl--buffer-type-eq 'mentions)) - mastodon-images-in-notifs - t)) - (mastodon-media--get-media-link-rendering ; placeholder: "[img]" - .preview_url remote-url ; for shr-browse-url - .type .description sensitive) - ;; return URL/caption: - (concat (mastodon-tl--propertize-img-str-or-url - (concat "Media:: " .preview_url) ; string - .preview_url remote-url .type .description - display-str 'shr-link .description sensitive) - "\n"))))) - -(defun mastodon-tl--propertize-img-str-or-url - (str media-url full-remote-url type help-echo - &optional display face caption sensitive) - "Propertize an media placeholder string \"[img]\" or media URL. -STR is the string to propertize, MEDIA-URL is the preview link, -FULL-REMOTE-URL is the link to the full resolution image on the -server, TYPE is the media type. -HELP-ECHO, DISPLAY, and FACE are the text properties to add. -CAPTION is the image caption, added as a text property. -SENSITIVE is a flag from the item's JSON data." - (propertize str - 'media-url media-url - 'media-state (when (string= str "[img]") 'needs-loading) - 'media-type 'media-link - 'mastodon-media-type type - 'display display - 'face face - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url (or full-remote-url media-url) ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'image-description caption - 'sensitive sensitive - 'help-echo (if (or (string= type "image") - (string= type nil) - (string= type "unknown")) ; handle borked images - help-echo - (concat help-echo "\nC-RET: play " type " with mpv")))) - -;;; FULL IMAGE VIEW - -(define-derived-mode mastodon-image-mode image-mode - "mastodon-image" - :group 'mastodon - ;; Disable `pixel-scroll-precision-mode' locally because it doesn't - ;; work nicely with `mastodon-image-mode': - ;; thanks Tusar for this fix: - (when (bound-and-true-p pixel-scroll-precision-mode) - (setq-local pixel-scroll-precision-mode nil))) - -;; patch `shr-browse-image' to accept url arg: -(defun mastodon-tl-shr-browse-image (&optional arg) - "Browse the image under point. -With a prefix argument, copy the URL of the image instead. -If URL is a string, use it rather than the image-url property at point." - (interactive "P") - (let ((prop (get-text-property (point) 'image-url))) - (if current-prefix-arg - (if (not prop) - (user-error "No image at point?") - (with-temp-buffer - (insert prop) - (copy-region-as-kill (point-min) (point-max)) - (message "Copied %s" prop))) - (let ((url (or arg prop))) - (if (not url) - (user-error "No URL here?") - (message "Browsing %s..." url) - (browse-url url)))))) - -(defun mastodon-tl--view-image-url (url attachments) - "View image URL. Set ATTACHMENTS metadata in image buffer." - (if (not url) - (user-error "No url found") - (if (not mastodon-tl--load-full-sized-images-in-emacs) - (mastodon-tl-shr-browse-image url) - (mastodon-media--image-or-cached - url #'mastodon-media--process-full-sized-image-response - `(nil ,url ,attachments ,(buffer-name)))))) - -(defun mastodon-tl-view-full-image-at-point () - "Browse full-sized version of image at point in a new window." - (interactive) - (if (not (eq (mastodon-tl--property 'mastodon-tab-stop) 'image)) - (user-error "No image at point?") - (let* ((url (mastodon-tl--property 'image-url)) - (attachments (mastodon-tl--property 'attachments))) - (mastodon-tl--view-image-url url attachments)))) - -(defun mastodon-tl-view-first-full-image () - "From item byline, fetch load its first full image." - (interactive) - (let* ((attachments (mastodon-tl--property 'attachments)) - (url (plist-get (car attachments) :url))) - (if (not attachments) - (user-error "Toot has no attachments") - (mastodon-tl--view-image-url url attachments)))) - -(defun mastodon-tl--get-next-image-url () - "Return the url for the next image to load. -Cycles through values in `mastodon-media--attachments'." - (let* ((url (car mastodon-media--attachments)) - ;; match url against our plists: - (current (mastodon-tl--current-image-url url))) - ;; fetch from next item in current or use first item if current has - ;; only 1 item: - (plist-get (if (= 1 (length current)) - (cadr mastodon-media--attachments) - (cadr current)) - :url))) - -(defun mastodon-tl--current-image-url (url) - "Try to fetch URL from `mastodon-media--attachments'. -The return value is that of `cl-member-if', ie if a match is found, it -returns the match and the list of which it is the car." - (cl-member-if - (lambda (attachment) - (equal url (plist-get attachment :url))) - (cdr mastodon-media--attachments))) - -(defun mastodon-tl--get-prev-image-url () - "Return the URL of the previous item in `mastodon-media--attachments'." - (let* ((url (car mastodon-media--attachments)) - (current (mastodon-tl--current-image-url url))) - (plist-get (nth (1- (length current)) - (cdr mastodon-media--attachments)) - :url))) - -(defun mastodon-tl-next-full-image () - "From full image view buffer, load the toot's next image." - (interactive) - (let* ((next-url (mastodon-tl--get-next-image-url))) - (mastodon-tl--view-image-url next-url - (cdr mastodon-media--attachments)))) - -(defun mastodon-tl-prev-full-image () - "From full image view buffer, load the toot's prev image." - (interactive) - (let* ((prev-url (mastodon-tl--get-prev-image-url))) - (mastodon-tl--view-image-url prev-url - (cdr mastodon-media--attachments)))) - -(defun mastodon-tl-toggle-sensitive-image () - "Toggle dislay of sensitive image at point." - (interactive) - (if (not (eq t (mastodon-tl--property 'sensitive))) - (user-error "No sensitive media at point?") - (let ((data (mastodon-tl--property 'image-data :no-move)) - (inhibit-read-only t) - (end (next-single-property-change (point) 'sensitive-state))) - (add-text-properties - (point) end - (if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move)) - ;; display: - `( display ,data - sensitive-state showing) - ;; hide: - `( sensitive-state hidden - display - ,(create-image - mastodon-media--sensitive-image-data nil t))))))) - - -;; POLLS - -(defun mastodon-tl--format-poll-option (option counter length) - "Format poll OPTION. COUNTER is a counter. -LENGTH is of the longest option, for formatting." - (format "%s: %s%s%s\n" - counter - (propertize (alist-get 'title option) - 'face 'success) - (make-string (1+ (- length - (length (alist-get 'title option)))) - ?\ ) - ;; TODO: disambiguate no votes from hidden votes - (format "[%s votes]" (or (alist-get 'votes_count option) - "0")))) - -(defun mastodon-tl--format-poll (poll) - "From json poll data POLL, return a display string." - (let-alist poll - (let* ((options (mastodon-tl--map-alist 'title .options)) - (longest (car (sort (mapcar #'length options ) #'>))) - (counter 0)) - (concat "\n" - (mastodon-tl--symbol 'poll) - "\n\n" - (mapconcat (lambda (option) - (setq counter (1+ counter)) - (mastodon-tl--format-poll-option - option counter longest)) - .options - "\n") - "\n" - (propertize - (cond (.voters_count ; sometimes it is nil - (format "%s %s | " .voters_count - (if (= .voters_count 1) "person" "people"))) - (.vote_count - (format "%s votes | " .vote_count)) - (t "")) - 'face 'mastodon-toot-docs-face) - (let ((str (if (eq .expired :json-false) - (if (eq .expires_at nil) - "" - (mastodon-tl--format-poll-expiry .expires_at)) - "Poll expired."))) - (propertize str 'face 'mastodon-toot-docs-face)) - "\n")))) - -(defconst mastodon-tl--time-units - '("sec" 60.0 ;; Use a float to convert `n' to float. - "min" 60 - "hour" 24 - "day" 7 - "week" 4.345 - "month" 12 - "year")) - -(defun mastodon-tl--format-poll-expiry (timestamp) - "Convert poll expiry TIMESTAMP into a descriptive string. -TIMESTAMP is from the expires_at field of a poll's JSON data, and -is in ISO 8601 Datetime format." - (let* ((ts (encode-time (parse-time-string timestamp))) - (seconds (time-to-seconds (time-subtract ts nil)))) - ;; FIXME: Use the `cdr' to update poll expiry times? - (concat (car (mastodon-tl--human-duration (max 0 seconds))) " left"))) - -(defun mastodon-tl--human-duration (seconds &optional resolution) - "Return a string describing SECONDS in a more human-friendly way. -The return format is (STRING . RES) where RES is the resolution of -this string, in seconds. -RESOLUTION is the finest resolution, in seconds, to use for the -second part of the output (defaults to 60, so that seconds are only -displayed when the duration is smaller than a minute)." - (cl-assert (>= seconds 0)) - (unless resolution (setq resolution 60)) - (let* ((units mastodon-tl--time-units) - (n1 seconds) (unit1 (pop units)) (res1 1) - n2 unit2 res2 - next) - (while (and units (> (truncate (setq next (/ n1 (car units)))) 0)) - (setq unit2 unit1) - (setq res2 res1) - (setq n2 (- n1 (* (car units) (truncate n1 (car units))))) - (setq n1 next) - (setq res1 (truncate (* res1 (car units)))) - (pop units) - (setq unit1 (pop units))) - (setq n1 (truncate n1)) - (if n2 (setq n2 (truncate n2))) - (cond - ((null n2) - ;; revert to old just now style for < 1 min: - (cons "just now" 60)) - ;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) - ;; (max resolution res1))) - ((< (* res2 n2) resolution) - (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) - (max resolution res2))) - ((< res2 resolution) - (let ((n2 (/ (* resolution (/ (* n2 res2) resolution)) res2))) - (cons (format "%d %s%s, %d %s%s" - n1 unit1 (if (> n1 1) "s" "") - n2 unit2 (if (> n2 1) "s" "")) - resolution))) - (t - (cons (format "%d %s%s, %d %s%s" - n1 unit1 (if (> n1 1) "s" "") - n2 unit2 (if (> n2 1) "s" "")) - (max res2 resolution)))))) - -(defun mastodon-tl--format-read-poll-option (options) - "Format poll OPTIONS for `completing-read'. -OPTIONS is an alist." - ;; we display option number and the option title - ;; but also store both as a cons cell as the cdr, as we need it later - (cl-loop for cell in options - collect (cons (format "%s | %s" (car cell) (cdr cell)) - cell))) - -(defun mastodon-tl--read-poll-option () - "Read a poll option to vote on a poll." - (let* ((toot (mastodon-tl--property 'item-json)) - (poll (mastodon-tl--field 'poll toot))) - (if (null poll) - (user-error "No poll here") - (let* ((options (mastodon-tl--field 'options poll)) - (titles (mastodon-tl--map-alist 'title options)) - (number-seq (number-sequence 1 (length options))) - (numbers (mapcar #'number-to-string number-seq)) - (options-alist (cl-mapcar #'cons numbers titles)) - (candidates (mastodon-tl--format-read-poll-option options-alist)) - (choice (completing-read "Poll option to vote for: " - candidates nil :match))) - (list (cdr (assoc choice candidates))))))) - -(defun mastodon-tl-poll-vote (option) - "If there is a poll at point, prompt user for OPTION to vote on it." - (interactive (mastodon-tl--read-poll-option)) - (let ((toot (mastodon-tl--property 'item-json))) - (if (null (mastodon-tl--field 'poll toot)) - (user-error "No poll here") - (let* ((poll (mastodon-tl--field 'poll toot)) - (id (alist-get 'id poll)) - (url (mastodon-http--api (format "polls/%s/votes" id))) - ;; zero-index our option: - (option-arg (number-to-string - (1- (string-to-number (car option))))) - (arg `(("choices[]" . ,option-arg))) - (response (mastodon-http--post url arg))) - (mastodon-http--triage response - (lambda (_) - (message "You voted for option %s: %s!" - (car option) (cdr option)))))))) - - -;; VIDEOS / MPV - -(defun mastodon-tl--find-first-video-in-attachments () - "Return the first media attachment that is a moving image." - (let ((attachments (mastodon-tl--property 'attachments)) - vids) - (cl-loop for x in attachments - do (let ((att-type (plist-get x :type))) - (when (or (string= "video" att-type) - (string= "gifv" att-type)) - (push x vids)))) - (car vids))) - -(defun mastodon-tl-mpv-play-video-from-byline () - "Run `mastodon-tl-mpv-play-video-at-point' on first moving image in post." - (interactive) - (let* ((video (mastodon-tl--find-first-video-in-attachments)) - (url (plist-get video :url)) - (type (plist-get video :type))) - (mastodon-tl-mpv-play-video-at-point url type))) - -(defun mastodon-tl-view-full-image-or-play-video (_pos) - "View full sized version of image at point, or try to play video." - (interactive "d") - (if (mastodon-tl--media-video-p) - (mastodon-tl-mpv-play-video-at-point) - (mastodon-tl-view-full-image-at-point))) - -(defun mastodon-tl-click-image-or-video (event) - "Click to play video with `mpv.el'. -EVENT is a mouse-click arg." - (interactive "@e") - (mastodon-tl-view-full-image-or-play-video - (posn-point (event-end event)))) - -(defun mastodon-tl--media-video-p (&optional type) - "T if mastodon-media-type prop is \"gifv\" or \"video\". -TYPE is a mastodon media type." - (let ((type (or type (mastodon-tl--property 'mastodon-media-type :no-move)))) - (or (string= type "gifv") - (string= type "video")))) - -(defun mastodon-tl-mpv-play-video-at-point (&optional url type) - "Play the video or gif at point with an mpv process. -URL and TYPE are provided when called while point is on byline, -in which case play first video or gif from current toot." - (interactive) - (let ((url (or url ; point in byline: - (mastodon-tl--property 'image-url :no-move)))) ; point in toot - (if (or (not url) - (not (mastodon-tl--media-video-p type))) - (user-error "No moving image here?") - (message "'q' to kill mpv.") - (condition-case x - (mpv-start "--loop" url) - (void-function - (message "Looks like mpv.el not installed. Error: %s" - (error-message-string x))))))) - -(defun mastodon-tl-copy-image-caption () - "Copy the caption of the image at point." - (interactive) - (if-let* ((desc (get-text-property (point) 'image-description))) - (progn - (kill-new desc) - (message "Image caption copied.")) - (message "No image caption."))) - - -;;; INSERT TOOTS - -(defun mastodon-tl--content (toot) - "Retrieve text content from TOOT. -Runs `mastodon-tl--render-text' and fetches poll or media." - (let* ((content (mastodon-tl--field 'content toot)) - (poll-p (mastodon-tl--field 'poll toot)) - (media-p (mastodon-tl--field 'media_attachments toot))) - (concat (mastodon-tl--render-text content toot) - (when poll-p - (mastodon-tl--format-poll - (mastodon-tl--field 'poll toot))) ;; toot or reblog - (when media-p - (mastodon-tl--media toot))))) - -(defun mastodon-tl--prev-item-id () - "Return the id of the last toot inserted into the buffer." - (let* ((prev-change - (save-excursion - (previous-single-property-change (point) 'base-item-id))) - (prev-pos (when prev-change (1- prev-change)))) - (when prev-pos - (get-text-property prev-pos 'base-item-id)))) - -(defun mastodon-tl--after-reply-status (reply-to-id) - "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer." - (let ((prev-id (mastodon-tl--prev-item-id))) - (string= reply-to-id prev-id))) - -(defun mastodon-tl--body-tags (body) - "Return a plain string list of the tags in BODY." - ;; NB: replies on text props 'mastodon-tab-stop and 'shr-url - ;; FIXME: snac tags fail our prop test, not sure about others. - (let (list prop) - (with-temp-buffer - (insert body) - (goto-char (point-min)) - (save-match-data - (while - (setq prop (text-property-search-forward - 'mastodon-tab-stop 'hashtag t)) - (goto-char (prop-match-beginning prop)) - (let ((tag (mastodon-tl--property 'mastodon-tag))) - (when tag - (push (downcase tag) list))) - (goto-char (prop-match-end prop))))) - list)) - -(defun mastodon-tl--insert-quoted (data) - "Propertize quoted status DATA for insertion." - (let ((bar (concat " " (mastodon-tl--symbol 'reply-bar))) - (content (map-nested-elt data '(quoted_status content))) - ;; quote symbol hack: - (quotemark (propertize "“" 'face - '(t :inherit success :weight bold - :height 1.8)))) - (propertize - (concat quotemark "\n" - ;; author byline without horiz bar and toot stats: - (mastodon-tl--byline-author - (alist-get 'quoted_status data) nil :domain :base) - "\n" - ;; quoted text: - (mastodon-tl--render-text content - (alist-get 'quoted_status data))) - 'line-prefix bar - 'wrap-prefix bar - 'mastodon-quote data))) - -(defun mastodon-tl--insert-status - (toot body &optional detailed-p thread domain unfolded no-byline - cw-expanded) - "Display the content and byline of timeline element TOOT. -BODY will form the section of the toot above the byline. -DETAILED-P means display more detailed info. For now -this just means displaying toot client. -THREAD means the status will be displayed in a thread view. -When DOMAIN, force inclusion of user's domain in their handle. -UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. -NO-BYLINE means just insert toot body, used for folding. -CW-EXPANDED means treat content warnings as unfolded." - (let* ((reply-to-id (alist-get 'in_reply_to_id toot)) - (after-reply-status-p - (when (and thread reply-to-id) - (mastodon-tl--after-reply-status reply-to-id))) - ;; (type (alist-get 'type toot)) - (toot-foldable - (and mastodon-tl--fold-toots-at-length - (length> body mastodon-tl--fold-toots-at-length))) - (cw-p (not - (string-empty-p - (alist-get 'spoiler_text toot)))) - (body-tags (mastodon-tl--body-tags body)) - (quote (mastodon-tl--field 'quote toot))) - (insert - (propertize ;; body + byline: - (concat - (propertize ;; body only: - (concat - "\n" - (mastodon-tl--top-byline toot) ;; (boost, in reply to) - ;; relpy symbol: - (when (and after-reply-status-p thread) - (concat (mastodon-tl--symbol 'replied) - "\n")) - ;; actual body: - (let ((bar (mastodon-tl--symbol 'reply-bar)) - (body (if (and toot-foldable (not unfolded)) - (mastodon-tl--fold-body body) - body))) - (concat - (if (and after-reply-status-p thread) - (propertize body - 'line-prefix bar - 'wrap-prefix bar) - body) - ;; insert quote maybe: - (when quote - (concat "\n\n" - (mastodon-tl--insert-quoted quote) - )))) - (if (and toot-foldable unfolded cw-expanded) - (mastodon-tl--read-more-or-less - "LESS" cw-p (not cw-expanded)) - "")) - 'toot-body t) ;; includes newlines etc. for folding - ;; post tags: - (let ((tags (alist-get 'tags toot))) - ;; FIXME: we also need to test here for normal body tags, and if - ;; so, don't go ahead: - (if tags (concat (mastodon-tl--base-tags tags body-tags)) "")) - ;; byline: - "\n" - (if no-byline - "" - (mastodon-tl--byline toot detailed-p domain))) - 'item-type 'toot - 'item-id (alist-get 'id toot) ; toot id - 'base-item-id (mastodon-tl--item-id toot) ; with reblog check - 'item-json toot - 'cursor-face 'mastodon-cursor-highlight-face - 'toot-foldable toot-foldable - 'toot-folded (and toot-foldable (not unfolded))) - (if no-byline "" "\n")))) - -(defun mastodon-tl--is-reply (toot) - "Check if the TOOT is a reply to another one (and not boosted). -Used as a predicate in `mastodon-tl--timeline'." - (and (mastodon-tl--field 'in_reply_to_id toot) - (eq :json-false (mastodon-tl--field 'reblogged toot)))) - -(defun mastodon-tl--filters-alist (filters) - "Parse filter data for FILTERS. -For each filter, return a list of action (warn or hide), filter -title, and context." - (cl-loop for x in filters ;; includes non filter elts! - for f = (alist-get 'filter x) - collect (list (alist-get 'filter_action f) - (alist-get 'title f) - (alist-get 'context f)))) - -(defun mastodon-tl--filter-by-context (context filters) - "Remove FILTERS that don't apply to the current CONTEXT." - (cl-remove-if-not - (lambda (x) - (member context (nth 2 x))) - filters)) - -(defun mastodon-tl--filters-context () - "Return a string of the current buffer's filter context. -Returns a member of `mastodon-views--filter-types'." - (let ((buf (mastodon-tl--get-buffer-type))) - (cond ((or (eq buf 'local) (eq buf 'federated)) - "public") - ((mastodon-tl--profile-buffer-p) - "profile") - ((eq buf 'list-timeline) - "home") ;; lists are "home" filter - (t ;; thread, notifs, home: - (symbol-name buf))))) - -(defun mastodon-tl--current-filters (filters) - "Return the filters from FILTERS data that apply in the current context. -For each filter, return a list of action (warn or hide), filter -title, and context." - (let ((context (mastodon-tl--filters-context)) - (filters-no-context (mastodon-tl--filters-alist filters))) - (mastodon-tl--filter-by-context context filters-no-context))) - -(defun mastodon-tl--toot (toot &optional detailed-p thread domain - unfolded no-byline cw-expanded) - "Format TOOT and insert it into the buffer. -DETAILED-P means display more detailed info. For now -this just means displaying toot client. -THREAD means the status will be displayed in a thread view. -When DOMAIN, force inclusion of user's domain in their handle. -UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. -NO-BYLINE means just insert toot body, used for folding. -CW-EXPANDED means treat content warnings as unfolded." - (let* ((mastodon-tl--expand-content-warnings - (or cw-expanded mastodon-tl--expand-content-warnings)) - (filtered (mastodon-tl--field 'filtered toot)) - (filters (when filtered - (mastodon-tl--current-filters filtered))) - (spoiler-or-content (if-let* ((match (assoc "warn" filters))) - (mastodon-tl--spoiler toot (cadr match)) - (if (mastodon-tl--has-spoiler toot) - (mastodon-tl--spoiler toot) - (mastodon-tl--content toot))))) - ;; If any filters are "hide", then we hide, - ;; even though item may also have a "warn" filter: - (unless (and filtered (assoc "hide" filters)) ;; no insert - (mastodon-tl--insert-status - toot (mastodon-tl--clean-tabs-and-nl spoiler-or-content) - detailed-p thread domain unfolded no-byline cw-expanded)))) - -(defun mastodon-tl--timeline (toots &optional thread domain no-byline) - "Display each toot in TOOTS. -This function removes replies if user required. -THREAD means the status will be displayed in a thread view. -When DOMAIN, force inclusion of user's domain in their handle. -NO-BYLINE means just insert toot body, used for folding." - (let ((start-pos (point)) - (toots ;; hack to *not* filter replies on profiles: - (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) - toots - (if (or ; we were called via --more*: - (mastodon-tl--buffer-property 'hide-replies nil :no-error) - ;; loading a tl with a prefix arg: - (mastodon-tl--hide-replies-p current-prefix-arg)) - (cl-remove-if-not #'mastodon-tl--is-reply toots) - toots)))) - (cl-loop for toot in toots - do (mastodon-tl--toot toot nil thread domain nil no-byline)) - ;; media: - (when mastodon-tl--display-media-p - (mastodon-media--inline-images start-pos (point))) - (goto-char (point-min)))) - -;;; FOLDING - -(defun mastodon-tl--read-more-or-less (str cw invis) - "Return a read more or read less heading. -STR is an uppercase string, either MORE or LESS. -The heading is a link to toggle the fold status of the toot. -CW and INVIS are boolean values for the properties invisible and -mastodon-content-warning-body." - (let ((type (if (string= str "MORE") 'read-more 'read-less))) - (propertize - (mastodon-search--format-heading - (mastodon-tl--make-link (format "READ %s" str) type) - nil :no-newline) - 'mastodon-content-warning-body cw - 'invisible invis))) - -(defun mastodon-tl--fold-body (body) - "Fold toot BODY if it is very long. -Folding decided by `mastodon-tl--fold-toots-at-length'." - (let* ((invis (get-text-property (1- (length body)) 'invisible body)) - (cw (get-text-property (1- (length body)) - 'mastodon-content-warning-body body)) - (heading (mastodon-tl--read-more-or-less "MORE" cw invis)) - (display (concat (substring body 0 - mastodon-tl--fold-toots-at-length) - heading))) - (propertize display - 'read-more body))) - -(defun mastodon-tl-unfold-post (&optional fold) - "Unfold the toot at point if it is folded (read-more). -FOLD means to fold it instead." - (interactive) - (let ((at-byline (mastodon-tl--property 'byline :no-move))) - (if (save-excursion - (when (not at-byline) - (mastodon-tl-goto-next-item)) - (not (mastodon-tl--property 'toot-foldable :no-move))) - (user-error "No foldable item at point?") - (let* ((inhibit-read-only t) - (body-range (mastodon-tl--find-property-range 'toot-body - (point) :backward)) - (cw-range (mastodon-tl--find-property-range - 'mastodon-content-warning-body - (point) :backward)) - (cw-invis (when cw-range - (get-text-property (car cw-range) 'invisible))) - (toot (mastodon-tl--property 'item-json :no-move)) - ;; `replace-region-contents' is much too slow, our hack from - ;; fedi.el is much simpler and much faster: - (beg (car body-range)) - (end (cdr body-range)) - (last-point (point)) - (point-after-fold (> last-point - (+ beg mastodon-tl--fold-toots-at-length)))) - ;; save-excursion here useless actually: - ;; FIXME: because point goes to top of item, the screen gets scrolled - ;; by insertion - (goto-char beg) - (delete-region beg end) - (delete-char 1) ;; prevent newlines accumulating - ;; insert toot body: - (mastodon-tl--toot toot nil nil nil (not fold) :no-byline - (unless cw-invis :cw-expanded)) ;; respect CW state - ;; set toot-folded prop on entire toot (not just body): - (let ((toot-range ;; post fold action range: - (mastodon-tl--find-property-range 'item-json - (point) :backward))) - (add-text-properties (car toot-range) - (cdr toot-range) - `(toot-folded ,fold))) - ;; try to leave point somewhere sane: - (cond ((or at-byline - (and fold point-after-fold)) ;; point was in area now folded - (ignore-errors (forward-line -1)) ;; in case we are between - (mastodon-tl-goto-next-item)) ;; goto byline - (t - (goto-char last-point) - (when point-after-fold ;; point was in READ MORE heading: - (beginning-of-line)))) - (message (format "%s toot" (if fold "Fold" "Unfold"))))))) - -(defun mastodon-tl-fold-post () - "Fold post at point, if it is too long." - (interactive) - (mastodon-tl-unfold-post :fold)) - -(defun mastodon-tl-fold-post-toggle () - "Toggle the folding status of the toot at point." - (interactive) - (let* ((folded (mastodon-tl--property 'toot-folded :no-move))) - (mastodon-tl-unfold-post (not folded)))) - -;;; TOOT STATS - -;; calqued off mastodon-alt.el: -(defun mastodon-tl--toot-for-stats (&optional toot) - "Return the TOOT on which we want to extract stats. -If no TOOT is given, the one at point is considered." - (let* ((original-toot (or toot (get-text-property (point) 'item-json))) - (toot (or (alist-get 'status original-toot) - (when (alist-get 'type original-toot) - original-toot) - (alist-get 'reblog original-toot) - original-toot)) - (type (alist-get 'type (or toot)))) - (unless (member type '("follow" "follow_request")) - toot))) - -(defun mastodon-tl--toot-stats (toot) - "Return a right aligned string (using display align-to). -String is filled with TOOT statistics (boosts, favs, replies). -When the TOOT is a reblog (boost), statistics from reblogged -toots are returned. -To disable showing the stats, customize -`mastodon-tl--show-stats'." - (let-alist (mastodon-tl--toot-for-stats toot) - (let* ((faves-prop (propertize (format "%s" .favourites_count) - 'favourites-count .favourites_count)) - (boosts-prop (propertize (format "%s" .reblogs_count) - 'boosts-count .reblogs_count)) - (faves (format "%s %s" faves-prop (mastodon-tl--symbol 'favourite))) - (boosts (format "%s %s" boosts-prop (mastodon-tl--symbol 'boost))) - (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply))) - (stats (concat - (propertize faves - 'favourited-p (eq t .favourited) - 'favourites-field t - 'help-echo (format "%s favourites" .favourites_count) - 'face 'mastodon-toot-docs-face) - (propertize " | " 'face 'mastodon-toot-docs-face) - (propertize boosts - 'boosted-p (eq t .reblogged) - 'boosts-field t - 'help-echo (format "%s boosts" .reblogs_count) - 'face 'mastodon-toot-docs-face) - (propertize " | " 'face 'mastodon-toot-docs-face) - (propertize replies - 'replies-field t - 'replies-count .replies_count - 'help-echo (format "%s replies" .replies_count) - 'face 'mastodon-toot-docs-face))) - (right-spacing - (propertize " " - 'display - `(space :align-to (- right ,(+ (length stats) 7)))))) - (concat right-spacing stats)))) - - -;;; 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))) - - -;;; BUFFERS - -(defun mastodon-tl--endpoint-str-= (str &optional type) - "Return T if STR is equal to the current buffer's endpoint. -TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix." - (let ((endpoint-fun (mastodon-tl--endpoint nil :no-error))) - (cond ((eq type :prefix) - (string-prefix-p str endpoint-fun)) - ((eq type :suffix) - (string-suffix-p str endpoint-fun)) - (t - (string= str endpoint-fun))))) - -(defun mastodon-tl--get-buffer-type () - "Return a symbol descriptive of current mastodon buffer type. -Should work in all mastodon buffers. -Note that for many buffers, this requires `mastodon-tl--buffer-spec' -to be set. It is set for almost all buffers, but you still have to -call this function after it is set or use something else." - (let ((buffer-name (mastodon-tl--buffer-name nil :no-error))) - (cond (mastodon-toot-mode - ;; composing/editing (no buffer spec): - (if (string= "*edit toot*" (buffer-name)) - 'edit-toot - 'new-toot)) - ;; main timelines: - ((mastodon-tl--endpoint-str-= "timelines/home") - 'home) - ((string= "*mastodon-local*" buffer-name) - 'local) - ((mastodon-tl--endpoint-str-= "timelines/public") - 'federated) - ((mastodon-tl--endpoint-str-= "timelines/tag/" :prefix) - 'tag-timeline) - ((mastodon-tl--endpoint-str-= "timelines/list/" :prefix) - 'list-timeline) - ;; notifs: - ((string-suffix-p "mentions*" buffer-name) - 'mentions) - ((mastodon-tl--endpoint-str-= "notifications") - 'notifications) - ((mastodon-tl--endpoint-str-= "notifications/requests") - 'notification-requests) - ;; threads: - ((mastodon-tl--endpoint-str-= "context" :suffix) - 'thread) - ((mastodon-tl--endpoint-str-= "statuses" :prefix) - 'single-status) - ;; profiles: - ((mastodon-tl--profile-buffer-p) - (cond - ;; an own profile option is needlessly confusing e.g. for - ;; `mastodon-profile-account-view-cycle' - ;; profile note: - ((string-suffix-p "update-profile*" buffer-name) - 'update-profile-note) - ;; posts inc. boosts: - ((string-suffix-p "no-boosts*" buffer-name) - 'profile-statuses-no-boosts) - ((string-suffix-p "no-replies*" buffer-name) - 'profile-statuses-no-replies) - ((string-suffix-p "only-media*" buffer-name) - 'profile-statuses-only-media) - ((string-match-p "-tagged-" buffer-name) - 'profile-statuses-tagged) - ((mastodon-tl--endpoint-str-= "statuses" :suffix) - 'profile-statuses) - ;; profile followers - ((mastodon-tl--endpoint-str-= "followers" :suffix) - 'profile-followers) - ;; profile following - ((mastodon-tl--endpoint-str-= "following" :suffix) - 'profile-following))) - ((mastodon-tl--endpoint-str-= "preferences") - 'preferences) - ;; search - ((mastodon-tl--search-buffer-p) - (cond ((string= "accounts" (mastodon-search--buf-type)) - 'search-accounts) - ((string= "hashtags" (mastodon-search--buf-type)) - 'search-hashtags) - ((string= "statuses" (mastodon-search--buf-type)) - 'search-statuses))) - ;; trends - ((mastodon-tl--endpoint-str-= "trends/statuses") - 'trending-statuses) - ((mastodon-tl--endpoint-str-= "trends/tags") - 'trending-tags) - ((mastodon-tl--endpoint-str-= "trends/links") - 'trending-links) - ;; User's views: - ((mastodon-tl--endpoint-str-= "filters") - 'filters) - ((mastodon-tl--endpoint-str-= "lists") - 'lists) - ((mastodon-tl--endpoint-str-= "suggestions") - 'follow-suggestions) - ((mastodon-tl--endpoint-str-= "favourites") - 'favourites) - ((mastodon-tl--endpoint-str-= "bookmarks") - 'bookmarks) - ((mastodon-tl--endpoint-str-= "follow_requests") - 'follow-requests) - ((mastodon-tl--endpoint-str-= "scheduled_statuses") - 'scheduled-statuses) - ;; instance description - ((mastodon-tl--endpoint-str-= "instance") - 'instance-description) - ((string= "*mastodon-toot-edits*" buffer-name) - 'toot-edits) - ((string= "*masto-image*" (buffer-name)) - 'mastodon-image) - ((mastodon-tl--endpoint-str-= "timelines/link") - 'link-timeline) - ((mastodon-tl--endpoint-str-= "announcements") - 'announcements) - ;; followed hashtags - ((mastodon-tl--endpoint-str-= "followed_tags") - 'followed-hashtags)))) - -(defun mastodon-tl--buffer-type-eq (type) - "Return t if current buffer type is equal to symbol TYPE." - (eq (mastodon-tl--get-buffer-type) type)) - -(defun mastodon-tl--profile-buffer-p () - "Return t if current buffer is a profile buffer of any kind. -This includes the update profile note buffer, but not the preferences one." - (string-prefix-p "accounts" (mastodon-tl--endpoint nil :no-error))) - -(defun mastodon-tl--own-profile-buffer-p () - "Return t if we are viewing our own profile buffer. -We check that our account credientials id matches the endpoint id in the -buffer spec, which if in a profile buffer is of the form -\"accounts/$id/statuses\"." - (and (mastodon-tl--profile-buffer-p) - (let ((endpoint-id - (nth 1 - (split-string (mastodon-tl--endpoint) "/")))) - (string= (mastodon-auth--get-account-id) - endpoint-id)))) - -(defun mastodon-tl--search-buffer-p () - "T if current buffer is a search buffer." - (string-suffix-p "search" (mastodon-tl--endpoint nil :no-error))) - -(defun mastodon-tl--timeline-proper-p () - "Return non-nil if the current buffer is a \"proper\" timeline. -A proper timeline excludes notifications, threads, profiles, and -other toot buffers that aren't strictly mastodon timelines." - (let ((timeline-buffers - '(home federated local tag-timeline list-timeline profile-statuses))) - (member (mastodon-tl--get-buffer-type) timeline-buffers))) - -(defun mastodon-tl--hide-replies-p (&optional prefix) - "Return non-nil if replies should be hidden in the timeline. -We hide replies if user explictly set the -`mastodon-tl--hide-replies' or used PREFIX combination to open a -timeline." - (and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline - (or (mastodon-tl--buffer-property 'hide-replies nil :noerror) - mastodon-tl--hide-replies ; User configured to hide replies - (equal '(4) prefix)))) ; Timeline called with C-u prefix - - -;;; 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 "" "" 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)) - - -;;; THREADS - -(defun mastodon-tl-view-single-toot () - "View toot at point in a separate buffer." - (interactive) - (let ((id (mastodon-tl--property 'base-item-id))) - (mastodon-tl--single-toot id))) - -(defun mastodon-tl--single-toot (id) - "View toot in separate buffer. -ID is that of the toot to view." - (let* ((buffer (format "*mastodon-toot-%s*" id)) - (toot (mastodon-http--get-json - (mastodon-http--api (concat "statuses/" id))))) - (if (eq (caar toot) 'error) - (user-error "Error: %s" (cdar toot)) - (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) - #'mastodon-tl--update-toot - ;; id for reload on reply: - nil nil nil nil id) - (mastodon-tl--toot toot :detailed-p) - (goto-char (point-min)) - (when mastodon-tl--display-media-p - (mastodon-media--inline-images (point-min) - (point-max))) - (mastodon-tl-goto-next-item :no-refresh))))) - -(defun mastodon-tl--update-toot (json) - "Call `mastodon-tl-single-toot' on id found in JSON." - (let ((id (alist-get 'id json))) - (mastodon-tl--single-toot id))) - -(defun mastodon-tl-view-whole-thread () - "From a thread view, view entire thread. -If you load a thread from a toot, only the branches containing -are displayed by default. Call this if you subsequently want to -view all branches of a thread." - (interactive) - (if (not (eq (mastodon-tl--get-buffer-type) 'thread)) - (user-error "You need to be viewing a thread to call this") - (goto-char (point-min)) - (let ((id (mastodon-tl--property 'base-item-id))) - (mastodon-tl--thread-do id)))) - -(defun mastodon-tl-return () - "Load user profile or thread of item at point. -If item at point is a follow or follow request, load user profile. -Else load thread." - (interactive) - (let ((notif (mastodon-tl--property 'notification-type))) - (if (or (equal "follow" notif) - (equal "follow_request" notif)) - (let* ((json (mastodon-tl--property 'item-json)) - (handle (alist-get 'acct json))) - (mastodon-profile-show-user handle)) - (mastodon-tl-thread)))) - -(defun mastodon-tl-thread () - "Open thread buffer for toot at point." - (interactive) - (if (not (eq 'toot (mastodon-tl--property 'item-type :no-move))) - (user-error "Looks like there's no toot at point?") - (mastodon-tl--thread-do))) - -(defun mastodon-tl--thread-do (&optional thread-id) - "Open thread buffer for toot at point or with THREAD-ID. -This is the non-interactive version, so we can call it -programmatically and not crash into -`mastodon-toot--with-toot-item'." - ;; this function's var must not be id as the above macro binds id and - ;; even if we provide the arg (e.g. url-lookup), the macro definition - ;; overrides it, making the optional arg unusable! - (let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move))) - (type - (if (and (mastodon-tl--buffer-type-eq 'notifications) - mastodon-group-notifications) - (mastodon-tl--property 'notification-type) - (mastodon-tl--field 'type - (mastodon-tl--property 'item-json :no-move)))) - (unfolded-state (mastodon-tl--buffer-property 'thread-unfolded - (current-buffer) :noerror)) - (mastodon-tl--expand-content-warnings - ;; if reloading and thread was explicitly (un)folded, respect it: - (or (pcase unfolded-state - ('folded nil) - ('unfolded t) - (_ mastodon-tl--expand-content-warnings))))) - (if (or (string= type "follow_request") - (string= type "follow")) ; no can thread these - (user-error "No thread") - (let* ((endpoint (format "statuses/%s/context" id)) - (url (mastodon-http--api endpoint)) - (buffer (format "*mastodon-thread-%s*" id)) - (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: - (mastodon-http--api (concat "statuses/" id)) - nil :silent)) - (context (mastodon-http--get-json url nil :silent))) - (if (eq (caar toot) 'error) - (user-error "Error: %s" (cdar toot)) - (when (member (alist-get 'type toot) '("reblog" "favourite")) - (setq toot (alist-get 'status toot))) - (if (not (< 0 (+ (length (alist-get 'ancestors context)) - (length (alist-get 'descendants context))))) - ;; just print the lone toot: - (mastodon-tl--single-toot id) - ;; we have a thread: - (with-mastodon-buffer buffer #'mastodon-mode nil - (let ((marker (make-marker))) - (mastodon-tl--set-buffer-spec buffer endpoint - #'mastodon-tl--thread-do - nil nil nil nil id) - (when unfolded-state - (plist-put mastodon-tl--buffer-spec - 'thread-unfolded unfolded-state)) - (when-let* ((ancestors (alist-get 'ancestors context))) - (mastodon-tl--timeline ancestors :thread)) - (goto-char (point-max)) - (move-marker marker (point)) - ;; print re-fetched toot: - (mastodon-tl--toot toot :detailed-p :thread) - ;; inline images only for the toot - ;; (`mastodon-tl--timeline' handles the rest): - (when mastodon-tl--display-media-p - (mastodon-media--inline-images marker ;start-pos - (point))) - (when-let* ((descendants (alist-get 'descendants context))) - (mastodon-tl--timeline descendants :thread)) - ;; put point at the toot: - (goto-char (marker-position marker)) - (mastodon-tl-goto-next-item :no-refresh))))))))) - -(defun mastodon-tl-mute-thread () - "Mute the thread displayed in the current buffer. -Note that you can only (un)mute threads you have posted in." - (interactive) - (mastodon-tl--mute-or-unmute-thread)) - -(defun mastodon-tl-unmute-thread () - "Unmute the thread displayed in the current buffer. -Note that you can only (un)mute threads you have posted in." - (interactive) - (mastodon-tl--mute-or-unmute-thread :unmute)) - -(defun mastodon-tl--thread-parent-id () - "Return the ID of the top item in a thread." - (save-excursion - (mastodon-tl--goto-first-item) - (mastodon-tl--property 'base-item-id :no-move))) - -(defun mastodon-tl--mute-or-unmute-thread (&optional unmute) - "Mute a thread. -If UNMUTE, unmute it." - (let ((mute-str (if unmute "unmute" "mute"))) - (when (or (mastodon-tl--buffer-type-eq 'thread) - (mastodon-tl--buffer-type-eq 'notifications)) - (let* ((id - ;; the id for `mastodon-tl--user-in-thread-p' ought to be the - ;; top-level item: - (if (mastodon-tl--buffer-type-eq 'notifications) - (mastodon-tl--property 'base-item-id :no-move) - (mastodon-tl--thread-parent-id))) - (we-posted-p (mastodon-tl--user-in-thread-p id)) - (url (mastodon-http--api (format "statuses/%s/%s" id mute-str)))) - (if (not we-posted-p) - (user-error "You can only (un)mute a thread you have posted in") - (when (y-or-n-p (format "%s this thread? " mute-str)) - (let ((response (mastodon-http--post url))) - (mastodon-http--triage - response - (lambda (_) - (message (format "Thread %sd!" mute-str))))))))))) - -(defun mastodon-tl--map-account-id-from-toot (statuses) - "Return a list of the account IDs of the author of each toot in STATUSES." - (mapcar (lambda (status) - (map-nested-elt status '(account id))) - statuses)) - -(defun mastodon-tl--user-in-thread-p (id) - "Return non-nil if the logged-in user has posted to the current thread. -ID is that of the post the context is currently displayed for." - (let* ((context-json (mastodon-http--get-json - (mastodon-http--api (format "statuses/%s/context" id)) - nil :silent)) - (ancestors (alist-get 'ancestors context-json)) - (descendants (alist-get 'descendants context-json)) - (a-ids (mastodon-tl--map-account-id-from-toot ancestors)) - (d-ids (mastodon-tl--map-account-id-from-toot descendants))) - (or (member (mastodon-auth--get-account-id) a-ids) - (member (mastodon-auth--get-account-id) d-ids)))) - - -;;; FOLLOW/BLOCK/MUTE, ETC - -(defun mastodon-tl-follow-user (user-handle - &optional notify langs reblogs json) - "Query for USER-HANDLE from current status and follow that user. -If NOTIFY is \"true\", enable notifications when that user posts. -If NOTIFY is \"false\", disable notifications when that user posts. -Can be called to toggle NOTIFY on users already being followed. -LANGS is an array parameters alist of languages to filer user's posts by. -REBLOGS is a boolean string like NOTIFY, enabling or disabling -display of the user's boosts in your timeline. -JSON is a flag arg for `mastodon-http--post'." - (interactive (list (mastodon-tl--user-handles-get "follow"))) - (mastodon-tl--do-if-item - (mastodon-tl--do-user-action-and-response - user-handle "follow" nil notify langs reblogs json))) - -(defun mastodon-tl-follow-user-by-handle (user-handle) - "Prompt for a USER-HANDLE and follow that user. -USER-HANDLE can also be a URL to a user profile page." - ;; code adapted from sachac: - ;; https://sachachua.com/dotemacs/index.html#mastodon. thanks sachac! - (interactive "MHandle: ") - (when (string-match "https?://\\(.+?\\)/\\(@.+\\)" user-handle) - (setq user-handle - ;; sachac's model doesn't work with local user handles in URL, - ;; meaning the search below will fail, so we use our own - ;; URL-to-handle function, modified for the purpose: - ;; (concat (match-string 2 user-handle) "@" (match-string 1 user-handle)))) - (mastodon-tl--userhandle-from-url user-handle))) - (let* ((account (mastodon-profile--search-account-by-handle - user-handle)) - (user-id (alist-get 'id account)) - (name (if (not (string-empty-p - (alist-get 'display_name account))) - (alist-get 'display_name account) - (alist-get 'username account))) - (url (mastodon-http--api (format "accounts/%s/%s" user-id "follow")))) - (if account - (mastodon-tl--do-user-action-function url name - (substring user-handle 1) "follow") - (user-error "Cannot find a user with handle %S" user-handle)))) - -;; TODO: make this action "enable/disable notifications" -(defun mastodon-tl-enable-notify-user-posts (user-handle) - "Query for USER-HANDLE and enable notifications when they post." - (interactive (list (mastodon-tl--user-handles-get "enable"))) - (mastodon-tl--do-if-item - (mastodon-tl-follow-user user-handle "true"))) - -(defun mastodon-tl-disable-notify-user-posts (user-handle) - "Query for USER-HANDLE and disable notifications when they post." - (interactive (list (mastodon-tl--user-handles-get "disable"))) - (mastodon-tl-follow-user user-handle "false")) - -(defun mastodon-tl-follow-user-disable-boosts (user-handle) - "Prompt for a USER-HANDLE, and disable display of boosts in home timeline. -If they are also not yet followed, follow them." - (interactive (list (mastodon-tl--user-handles-get "disable boosts"))) - (mastodon-tl-follow-user user-handle nil nil "false")) - -(defun mastodon-tl-follow-user-enable-boosts (user-handle) - "Prompt for a USER-HANDLE, and enable display of boosts in home timeline. -If they are also not yet followed, follow them. -You only need to call this if you have previously disabled -display of boosts." - (interactive (list (mastodon-tl--user-handles-get "enable boosts"))) - (mastodon-tl-follow-user user-handle nil nil "true")) - -(defun mastodon-tl-filter-user-user-posts-by-language (user-handle) - "Query for USER-HANDLE and filter display of their posts by language. -If they are not already followed, they will be too. -To be filtered, a post has to be marked as in the language given. -This may mean that you will not see posts that are in your -desired language if they are not marked as such (or as anything)." - (interactive (list (mastodon-tl--user-handles-get "filter by language"))) - (let ((langs (mastodon-tl--read-filter-langs))) - (mastodon-tl--do-if-item - (if (string= "" (cdar langs)) - (mastodon-tl-unfilter-user-languages user-handle) - (mastodon-tl-follow-user user-handle nil langs))))) - -(defun mastodon-tl-unfilter-user-languages (user-handle) - "Remove any language filters for USER-HANDLE. -This means you will receive posts of theirs marked as being in -any or no language." - (interactive (list (mastodon-tl--user-handles-get "filter by language"))) - (let ((langs "languages[]")) - (mastodon-tl--do-if-item - ;; we need "languages[]" as a param, with no "=" and not json-encoded as - ;; a string - (mastodon-tl-follow-user user-handle nil langs nil :raw)))) - -(defun mastodon-tl--read-filter-langs (&optional langs) - "Read language choices and return an alist array parameter. -LANGS is the accumulated array param alist if we re-run recursively." - (let* ((iso-const mastodon-iso-639-1) - (iso (cons '("None (all)" . "") iso-const)) - (langs-alist langs) - (choice (completing-read "Filter user's posts by language: " - iso))) - (when choice - (setq langs-alist - (push `("languages[]" . ,(alist-get choice iso - nil nil #'string=)) - langs-alist)) - (if (y-or-n-p "Filter by another language? ") - (mastodon-tl--read-filter-langs langs-alist) - langs-alist)))) - -(defun mastodon-tl-unfollow-user (user-handle) - "Query for USER-HANDLE from current status and unfollow that user." - (interactive (list (mastodon-tl--user-handles-get "unfollow"))) - (mastodon-tl--do-if-item - (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) - -(defun mastodon-tl-block-user (user-handle) - "Query for USER-HANDLE from current status and block that user." - (interactive (list (mastodon-tl--user-handles-get "block"))) - (mastodon-tl--do-if-item - (mastodon-tl--do-user-action-and-response user-handle "block"))) - -(defun mastodon-tl-unblock-user (user-handle) - "Query for USER-HANDLE from list of blocked users and unblock that user." - (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unblock"))) - (if (not user-handle) - (user-error "Looks like you have no blocks to unblock!") - (mastodon-tl--do-user-action-and-response user-handle "unblock" t))) - -(defun mastodon-tl-mute-user (user-handle) - "Query for USER-HANDLE from current status and mute that user." - (interactive (list (mastodon-tl--user-handles-get "mute"))) - (mastodon-tl--do-if-item - (mastodon-tl--do-user-action-and-response user-handle "mute"))) - -(defun mastodon-tl-unmute-user (user-handle) - "Query for USER-HANDLE from list of muted users and unmute that user." - (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unmute"))) - (if (not user-handle) - (user-error "Looks like you have no mutes to unmute!") - (mastodon-tl--do-user-action-and-response user-handle "unmute" t))) - -(defun mastodon-tl-dm-user (user-handle) - "Query for USER-HANDLE from current status and compose a message to that user." - (interactive (list (mastodon-tl--user-handles-get "message"))) - (mastodon-tl--do-if-item - (mastodon-toot--compose-buffer (concat "@" user-handle)) - (setq mastodon-toot--visibility "direct") - (mastodon-toot--update-status-fields))) - -(defun mastodon-tl--user-handles-get (action) - "Get the list of user-handles for ACTION from the current toot." - (mastodon-tl--do-if-item - (let ((user-handles - (cond - ((or ; follow suggests / search / foll requests compat: - (member (mastodon-tl--get-buffer-type) - '( follow-suggestions search follow-requests - ;; profile follows/followers but not statuses: - profile-followers profile-following))) - ;; fetch 'item-json: - (list (alist-get 'acct - (mastodon-tl--property 'item-json :no-move)))) - ;; profile view, point in profile details, poss no toots - ;; needed for e.g. gup.pe groups which show no toots publically: - ((and (mastodon-tl--profile-buffer-p) - (get-text-property (point) 'profile-json)) - (list (alist-get 'acct - (mastodon-profile--profile-json)))) - ;; (grouped) notifications: - ((member (mastodon-tl--get-buffer-type) '(mentions notifications)) - (append ;; those acting on item: - (cl-remove-duplicates - (cl-loop for a in (mastodon-tl--property - 'notification-accounts :no-move) - collect (alist-get 'acct a))) - ;; mentions in item: - (mastodon-profile--extract-users-handles - (mastodon-profile--item-json)))) - (t - (mastodon-profile--extract-users-handles - (mastodon-profile--item-json)))))) - (completing-read - (cond ((or ; TODO: make this "enable/disable notifications" - (string= action "disable") - (string= action "enable")) - (format "%s notifications when user posts: " action)) - ((string-suffix-p "boosts" action) - (format "%s by user: " action)) - (t (format "Handle of user to %s: " action))) - user-handles nil ; predicate - 'confirm)))) - -(defun mastodon-tl--get-blocks-or-mutes-list (action) - "Fetch the list of accounts for ACTION from the server. -Action must be either \"unblock\" or \"unmute\"." - (let* ((endpoint (cond ((string= action "unblock") - "blocks") - ((string= action "unmute") - "mutes"))) - (url (mastodon-http--api endpoint)) - (json (mastodon-http--get-json url)) - (accts (mastodon-tl--map-alist 'acct json))) - (when accts - (completing-read (format "Handle of user to %s: " action) - accts nil :match)))) - -(defun mastodon-tl--do-user-action-and-response - (user-handle action &optional negp notify langs reblogs json) - "Do ACTION on user USER-HANDLE. -NEGP is whether the action involves un-doing something. -If NOTIFY is \"true\", enable notifications when that user posts. -If NOTIFY is \"false\", disable notifications when that user posts. -NOTIFY is only non-nil when called by `mastodon-tl-follow-user'. -LANGS is an array parameters alist of languages to filer user's posts by. -REBLOGS is a boolean string like NOTIFY, enabling or disabling -display of the user's boosts in your timeline." - (let* ((account - (cond - (negp ;; unmuting/unblocking, use mute/block list - (mastodon-profile--search-account-by-handle user-handle)) - ;; (grouped) notifications: - ((member (mastodon-tl--get-buffer-type) - '(mentions notifications)) - (let ((accounts (mastodon-tl--property 'notification-accounts))) - (or (cl-some (lambda (x) - (when (string= user-handle (alist-get 'acct x)) - x)) - accounts) - (mastodon-profile--lookup-account-in-status - user-handle - (mastodon-profile--item-json))))) - (t - (mastodon-profile--lookup-account-in-status - user-handle - (if (mastodon-tl--profile-buffer-p) - ;; profile view, use 'profile-json as status: - (mastodon-profile--profile-json) - ;; muting/blocking, select from handles in current status - (mastodon-profile--item-json)))))) - (user-id (alist-get 'id account)) - (name (mastodon-tl--display-or-uname account)) - (args (cond (notify `(("notify" . ,notify))) - (langs langs) - (reblogs `(("reblogs" . ,reblogs))) - (t nil))) - (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) - (if (not account) - (user-error "Cannot find a user with handle %S" user-handle) - (when (or (string= action "follow") ;; y-or-n for all but follow - (y-or-n-p (format "%s user %s? " action name))) - (mastodon-tl--do-user-action-function - url name user-handle action notify args reblogs json))))) - -(defun mastodon-tl--do-user-action-function - (url name user-handle action &optional notify args reblogs json) - "Post ACTION on user NAME/USER-HANDLE to URL. -NOTIFY is either \"true\" or \"false\", and used when we have been called -by `mastodon-tl-follow-user' to enable or disable notifications. -ARGS is an alist of any parameters to send with the request." - (let ((response (mastodon-http--post url args nil nil json))) - (mastodon-http--triage - response - (lambda (response) - (let ((json (with-current-buffer response - (mastodon-http--process-json)))) - ;; TODO: when > if, with failure msg - (cond ((string= notify "true") - (when (eq t (alist-get 'notifying json)) - (message "Receiving notifications for user %s (@%s)!" - name user-handle))) - ((string= notify "false") - (when (eq :json-false (alist-get 'notifying json)) - (message "Not receiving notifications for user %s (@%s)!" - name user-handle))) - ((string= reblogs "true") - (when (eq t (alist-get 'showing_reblogs json)) - (message "Receiving boosts by user %s (@%s)!" - name user-handle))) - ((string= reblogs "false") - (when (eq :json-false (alist-get 'showing_reblogs json)) - (message "Not receiving boosts by user %s (@%s)!" - name user-handle))) - ((or (string= action "mute") - (string= action "unmute")) - (message "User %s (@%s) %sd!" name user-handle action)) - ((string= args "languages[]") - (message "User %s language filters removed!" name)) - ((assoc "languages[]" args #'string=) - (message "User %s filtered by language(s): %s" name - (mapconcat #'cdr args " "))) - ((not (or notify reblogs)) - (if (and (string= action "follow") - (eq t (alist-get 'requested json))) - (message "Follow requested for user %s (@%s)!" name user-handle) - (message "User %s (@%s) %sed!" name user-handle action))))))))) - -(defun mastodon-tl--get-domain-blocks () - "Return a list of current domain blocks." - (mastodon-http--get-json - (mastodon-http--api "domain_blocks"))) - -(defun mastodon-tl-block-domain () - "Read a domain and block it." - (interactive) - (let* ((domain (read-string "Block domain: ")) - (params `(("domain" . ,domain))) - (url (mastodon-http--api "domain_blocks")) - (resp (mastodon-http--post url params))) - (mastodon-http--triage - resp - (lambda (_) - (message "Domain blocked!"))))) - -(defun mastodon-tl-unblock-domain () - "Read a blocked domain and unblock it." - (interactive) - (let ((blocks (mastodon-tl--get-domain-blocks))) - (if (not blocks) - (user-error "No blocked domains?") - (let* ((domain (completing-read "Unblock domain: " - blocks)) - (params `(("domain" . ,domain))) - (url (mastodon-http--api "domain_blocks")) - (resp (mastodon-http--delete url params))) - (mastodon-http--triage - resp - (lambda (_) - (message "Domain unblocked!"))))))) - - -;; FOLLOW TAGS - -(defun mastodon-tl--get-tags-list () - "Return the list of tags of the toot at point." - (let* ((toot (mastodon-toot--base-toot-or-item-json)) - (tags (mastodon-tl--field 'tags toot))) - (mastodon-tl--map-alist 'name tags))) - -(defun mastodon-tl-follow-tag (&optional tag) - "Prompt for a tag (from post at point) and follow it. -If TAG provided, follow it." - (interactive) - (let* ((tags (unless tag (mastodon-tl--get-tags-list))) - (tag-at-point - (unless tag - (when (eq 'hashtag - (mastodon-tl--property 'mastodon-tab-stop :no-move)) - (mastodon-tl--property 'mastodon-tag :no-move)))) - (tag (or tag (completing-read - (format "Tag to follow [%s]: " tag-at-point) - tags nil nil nil nil tag-at-point))) - (url (mastodon-http--api (format "tags/%s/follow" tag))) - (response (mastodon-http--post url))) - (mastodon-http--triage response - (lambda (_) - (message "tag #%s followed!" tag))))) - -(defun mastodon-tl--followed-tags () - "Return JSON of tags followed." - (let ((url (mastodon-http--api (format "followed_tags")))) - (mastodon-http--get-json url))) - -(defun mastodon-tl-unfollow-tag (&optional tag) - "Prompt for a followed tag, and unfollow it. -If TAG is provided, unfollow it." - (interactive) - (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) - (tags (unless tag (mastodon-tl--map-alist 'name followed-tags-json))) - (tag (or tag (completing-read "Unfollow tag: " tags))) - (url (mastodon-http--api (format "tags/%s/unfollow" tag))) - (response (mastodon-http--post url))) - (mastodon-http--triage response - (lambda (_) - (message "tag #%s unfollowed!" tag))))) - -(defun mastodon-tl-jump-to-followed-tag (&optional prefix) - "Prompt for a followed tag and view its timeline. -PREFIX is sent to `mastodon-tl-get-tag-timeline', which see." - (interactive "p") - (let* ((followed-tags-json (mastodon-tl--followed-tags)) - (tags (mastodon-tl--map-alist 'name followed-tags-json)) - (tag (completing-read "Tag: " tags nil))) - (if (null tag) - (user-error "You have to follow some tags first") - (mastodon-tl-get-tag-timeline prefix tag)))) - -(defun mastodon-tl-list-followed-tags () - "List followed tags. View timeline of tag user choses. -PREFIX is sent to `mastodon-tl-get-tag-timeline', which see." - (interactive) - (let* ((json (mastodon-tl--followed-tags)) - (sorted (cl-sort json #'string-lessp - :key (lambda (x) - (downcase (alist-get 'name x))))) - (buf "*mastodon-followed-tags*")) - (if (null sorted) - (user-error "You have to follow some tags first") - (with-mastodon-buffer (get-buffer-create buf) - #'mastodon-mode nil - (mastodon-tl--set-buffer-spec - buf "followed_tags" #'mastodon-tl-list-followed-tags) - (mastodon-search--insert-heading "followed tags") - (insert "\n") - (mastodon-search--print-tags sorted) - (goto-char (point-min)))))) - -(defun mastodon-tl-followed-tags-timeline (&optional prefix) - "Open a timeline of multiple tags. -With a single PREFIX arg, only show posts with media. -With a double PREFIX arg, limit results to your own instance. -If `mastodon-tl--tag-timeline-tags' is set, use its tags, else -fetch followed tags and load the first four of them." - (interactive "p") - (let* ((followed-tags-json (mastodon-tl--followed-tags)) - (tags (or mastodon-tl--tag-timeline-tags - (mastodon-tl--map-alist 'name followed-tags-json)))) - (mastodon-tl--show-tag-timeline prefix tags))) - -(defun mastodon-tl-some-followed-tags-timeline (&optional prefix) - "Prompt for some tags, and open a timeline for them. -The suggestions are from followed tags, but any other tags are also allowed. -PREFIX is for `mastodon-tl--show-tag-timeline', which see." - (interactive "p") - (let* ((followed-tags-json (mastodon-tl--followed-tags)) - (tags (mastodon-tl--map-alist 'name followed-tags-json)) - (selection (completing-read-multiple - "Tags' timelines to view [TAB to view, comma to separate]: " - tags))) - (mastodon-tl--show-tag-timeline prefix selection))) - -(defcustom mastodon-tl--tags-groups nil - "A list containing lists of up to four tags each. -You can load a tag timeline list with one of these by calling -`mastodon-tl-tag-group-timeline'." - :group 'mastodon-tl - :type '(repeat (list string string string string))) - -(defun mastodon-tl-tag-group-timeline (&optional prefix) - "Load a timeline of a tag group from `mastodon-tl--tags-groups'. -PREFIX is for `mastodon-tl--show-tag-timeline', which see." - (interactive "P") - (if (not mastodon-tl--tags-groups) - (user-error - "Set `mastodon-tl--tags-groups' to view tag group timelines") - (let* ((list-strs (mapcar (lambda (x) - ;; cons of list-as-string and list: - (cons (prin1-to-string x) x)) - mastodon-tl--tags-groups)) - (choice (completing-read "Tag group: " list-strs)) - (choice-list (cdr (assoc choice list-strs #'equal)))) - (mastodon-tl--show-tag-timeline prefix choice-list)))) - - -;;; REPORT TO MODERATORS - -(defun mastodon-tl--instance-rules () - "Return the rules of the user's instance." - (let ((url (mastodon-http--api "instance/rules"))) - (mastodon-http--get-json url nil :silent))) - -(defun mastodon-tl--report-params (account toot) - "Query user and return report params alist. -ACCOUNT and TOOT are the data to use." - (let* ((account-id (alist-get 'id account)) - (comment (read-string "Add comment [optional]: ")) - (item-id (when (y-or-n-p "Also report status at point? ") - (mastodon-tl--item-id toot))) ; base toot if poss - (forward-p (when (y-or-n-p "Forward to remote admin? ") "true")) - (rules (when (y-or-n-p "Cite a rule broken? ") - (mastodon-tl--read-rules-ids))) - (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other")))) - (mastodon-tl--report-build-params account-id comment item-id - forward-p cat rules))) - -(defun mastodon-tl--report-build-params - (account-id comment item-id forward-p cat &optional rules) - "Build the parameters alist based on user responses. -ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from -`mastodon-tl--report-params', which see." - (let ((params - `(("account_id" . ,account-id) - ,@(when comment `(("comment" . ,comment))) - ,@(when item-id `(("status_ids[]" . ,item-id))) - ,@(when forward-p `(("forward" . ,forward-p))) - ,@(when cat `(("category" . ,cat)))))) - (if (not rules) - params - (let ((alist - (mastodon-http--build-array-params-alist "rule_ids[]" rules))) - (append alist params))))) - -(defun mastodon-tl-report-to-mods () - "Report the author of the toot at point to your instance moderators. -Optionally report the toot at point, add a comment, cite rules -that have been broken, forward the report to the remove admin, -report the account for spam." - (interactive) - (mastodon-tl--do-if-item - (when (y-or-n-p "Report author of toot at point?") - (let* ((url (mastodon-http--api "reports")) - (toot (mastodon-tl--toot-or-base - (mastodon-tl--property 'item-json :no-move))) - (account (alist-get 'account toot)) - (handle (alist-get 'acct account)) - (params (mastodon-tl--report-params account toot)) - (response (mastodon-http--post url params))) - (mastodon-http--triage response - (lambda (_) - (message "User %s reported!" handle))))))) - -(defvar crm-separator) - -(defun mastodon-tl--map-rules-alist (rules) - "Convert RULES text and id fields into an alist." - (mastodon-tl--map-alist-vals-to-alist 'text 'id rules)) - -(defun mastodon-tl--read-rules-ids () - "Prompt for a list of instance rules and return a list of selected ids." - (let* ((rules (mastodon-tl--instance-rules)) - (alist (mastodon-tl--map-rules-alist rules)) - (crm-separator (replace-regexp-in-string "," "|" crm-separator)) - (choices (completing-read-multiple - "rules [TAB for options, | to separate]: " - alist nil t))) - (mapcar (lambda (x) - (alist-get x alist nil nil #'string=)) - choices))) - - -;;; UPDATING, etc. - -(defun mastodon-tl--no-json (json) - "Nil if JSON is nil or empty group notif data." - (if (and (mastodon-tl--buffer-type-eq 'notifications) - mastodon-group-notifications) - (mastodon-notifications--empty-group-json-p json) - (not json))) - -(defun mastodon-tl--more-json (endpoint id) - "Return JSON for timeline ENDPOINT before ID." - (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url args))) - -(defun mastodon-tl--more-json-async - (endpoint id &optional params callback &rest cbargs) - "Return JSON for timeline ENDPOINT before ID. -Then run CALLBACK with arguments CBARGS. -PARAMS is used to send any parameters needed to correctly update -the current view." - (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) - (args (append args params)) - (url (mastodon-http--api - endpoint - (when (or (and mastodon-group-notifications - (string= endpoint "notifications")) - (string-suffix-p "search" endpoint)) - "v2")))) - (apply #'mastodon-http--get-json-async url args callback cbargs))) - -(defun mastodon-tl--more-json-async-offset (endpoint &optional params - callback &rest cbargs) - "Return JSON for ENDPOINT, using the \"offset\" query param. -This is used for pagination with endpoints that implement the -\"offset\" parameter, rather than using link-headers or -\"max_id\". -PARAMS are the update parameters, see -`mastodon-tl--update-params'. These (\"limit\" and \"offset\") -must be set in `mastodon-tl--buffer-spec' for pagination to work. -Then run CALLBACK with arguments CBARGS." - (let* ((params (or params (mastodon-tl--update-params))) - (limit (string-to-number - (alist-get "limit" params nil nil #'string=))) - (offset (number-to-string - (+ limit ; limit + old offset = new offset - (string-to-number - (alist-get "offset" params nil nil #'string=))))) - (url (mastodon-http--api - endpoint - (when (string-suffix-p "search" endpoint) - "v2")))) - ;; increment: - (setf (alist-get "offset" params nil nil #'string=) offset) - (apply #'mastodon-http--get-json-async url params callback cbargs))) - -(defun mastodon-tl--updated-json (endpoint id &optional params version) - "Return JSON for timeline ENDPOINT since ID. -PARAMS is used to send any parameters needed to correctly update -the current view. -VERSION is the API version to use, as grouped notifs use v2." - (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) - (args (append args params)) - (url (mastodon-http--api endpoint version))) - (mastodon-http--get-json url args))) - -;; TODO: add this to new posts in some cases, e.g. in thread view. -(defun mastodon-tl--reload-timeline-or-profile (&optional pos) - "Reload the current timeline or profile page. -For use after e.g. deleting a toot. -POS is a number, where point will be placed. -Aims to respect any pagination in effect." - (let ((type (mastodon-tl--get-buffer-type)) - (max-id (mastodon-tl--buffer-property 'max-id nil :no-error))) - (cond ((eq type 'home) - (mastodon-tl-get-home-timeline nil max-id)) - ((eq type 'federated) - (mastodon-tl-get-federated-timeline nil nil max-id)) - ((eq type 'local) - (mastodon-tl-get-local-timeline nil max-id)) - ((eq type 'mentions) - (mastodon-notifications-get-mentions)) - ((eq type 'notifications) - (mastodon-notifications-get nil nil max-id)) - ((eq type 'profile-statuses-no-boosts) - ;; TODO: max-id arg needed here also - (mastodon-profile-open-statuses-no-reblogs)) - ((eq type 'profile-statuses) - (save-excursion - (goto-char (point-min)) - (mastodon-profile--make-author-buffer - ;; (mastodon-profile-get-toot-author max-id))) - (mastodon-profile--profile-json)))) - ((or (eq type 'single-status) - (eq type 'thread)) - (let ((id (mastodon-tl--buffer-property - 'thread-item-id (current-buffer) :no-error))) - (mastodon-tl--thread-do id)))) - ;; TODO: sends point to where point was in buffer. This is very rough; we - ;; may have removed an item , so the buffer will be smaller, point will - ;; end up past where we were, etc. - (when pos - (goto-char pos) - (mastodon-tl-goto-prev-item :no-refresh)))) - -(defun mastodon-tl--build-link-header-url (str) - "Return a URL from STR, an http Link header." - (let* ((split (split-string str "; ")) - (url-base (string-trim (car split) "<" ">")) - (param (cadr split))) - (concat url-base "&" param))) - -(defun mastodon-tl--use-link-header-p () - "Return t if we are in a view needing Link header pagination. -Currently this includes favourites, bookmarks, follow requests, -and profile pages when showing followers or accounts followed." - (or (mastodon-tl--buffer-type-eq 'favourites) - (mastodon-tl--buffer-type-eq 'bookmarks) - (mastodon-tl--buffer-type-eq 'profile-followers) - (mastodon-tl--buffer-type-eq 'profile-following) - (mastodon-tl--buffer-type-eq 'follow-requests))) - -(defun mastodon-tl--get-link-header-from-response (headers) - "Get http Link header from list of http HEADERS." - ;; pleroma uses "link", so case-insensitive match required: - (when-let* ((link-headers (alist-get "Link" headers nil nil #'cl-equalp))) - (split-string link-headers ", "))) - -(defun mastodon-tl--more () - "Append older toots to timeline, asynchronously." - (message "Loading...") - (if (mastodon-tl--use-link-header-p) - ;; link-header paginate: - ;; can't build a URL with --more-json-async, endpoint/id: - ;; ensure we have a "next" type here, otherwise the CAR will be the - ;; "prev" type! - (let ((link-header (mastodon-tl--link-header))) - (if (> 2 (length link-header)) - (user-error "No next page") - (let* ((next (car link-header)) - ;;(prev (cadr (mastodon-tl--link-header))) - (url (mastodon-tl--build-link-header-url next))) - (mastodon-http--get-response-async - url nil 'mastodon-tl--more* (current-buffer) (point) :headers)))) - (cond (;; no paginate - (or (mastodon-tl--buffer-type-eq 'follow-suggestions) - (mastodon-tl--buffer-type-eq 'filters) - (mastodon-tl--buffer-type-eq 'lists)) - (user-error "No more results")) - ;; offset paginate (search, trending, user lists, ...?): - ((or (string-prefix-p "*mastodon-trending-" (buffer-name)) - (mastodon-tl--search-buffer-p)) - (mastodon-tl--more-json-async-offset - (mastodon-tl--endpoint) - (mastodon-tl--update-params) - 'mastodon-tl--more* (current-buffer) (point))) - (t ;; max_id paginate (timelines, items with ids/timestamps): - (let ((max-id (mastodon-tl--oldest-id)) - (params (mastodon-tl--update-params))) - (mastodon-tl--more-json-async - (mastodon-tl--endpoint) - max-id params - 'mastodon-tl--more* - (current-buffer) (point) nil max-id)))))) - -(defun mastodon-tl--more* - (response buffer point-before &optional headers max-id) - "Append older toots to timeline, asynchronously. -Runs the timeline's update function on RESPONSE, in BUFFER. -When done, places point at POINT-BEFORE. -HEADERS is the http headers returned in the response, if any. -MAX-ID is the pagination parameter, a string. -UPDATE-PARAMS is from prev buffer spec, added to the new one." - (with-current-buffer buffer - (if (not response) - (user-error "No more results") - (let* ((inhibit-read-only t) - (json (if headers (car response) response)) - ;; FIXME: max-id pagination works for statuses only, not other - ;; search results pages: - (json (if (not (mastodon-tl--search-buffer-p)) - json - (let ((type (mastodon-search--buf-type))) - (cond ((string= "statuses" type) - (cdr ; avoid repeat of last status - (alist-get 'statuses response))) - ((string= "hashtags" type) - (alist-get 'hashtags response)) - ((string= "accounts" type) - (alist-get 'accounts response)))))) - (headers (when headers (cdr response))) - (link-header - (mastodon-tl--get-link-header-from-response headers)) - (buf-type (mastodon-tl--get-buffer-type)) - (notifs-p (or (eq buf-type 'notifications) - (eq buf-type 'mentions))) - (notif-type (when notifs-p - (mastodon-notifications--current-type)))) - (goto-char (point-max)) - (if (eq 'thread buf-type) - ;; if thread fully unfolded, respect it: - ;; if thread view, call --thread-do with parent ID - (progn (goto-char (point-min)) - (mastodon-tl-goto-next-item) - (mastodon-tl--thread-do) - (goto-char point-before) - (message "Loaded full thread.")) - (if (mastodon-tl--no-json json) - (user-error "No more results") - (if notifs-p - (mastodon-notifications--timeline json notif-type :update) - (funcall (mastodon-tl--update-function) json)) - (goto-char point-before) - ;; update buffer spec to new link-header or max-id: - ;; (other values should just remain as they were) - (mastodon-tl--set-buffer-spec - (mastodon-tl--buffer-name) - (mastodon-tl--endpoint) - (mastodon-tl--update-function) - link-header (mastodon-tl--update-params) - (mastodon-tl--hide-replies-p) max-id) - (message "Loading... done."))))))) - -(defun mastodon-tl--find-property-range (property start-point - &optional search-backwards) - "Return nil if no such range is found. -If PROPERTY is set at START-POINT returns a range around -START-POINT otherwise before/after START-POINT. -SEARCH-BACKWARDS determines whether we pick point -before (non-nil) or after (nil)" - (if (get-text-property start-point property) - ;; We are within a range, so look backwards for the start: - (cons (previous-single-property-change - (if (eq start-point (point-max)) start-point (1+ start-point)) - property nil (point-min)) - (next-single-property-change start-point property nil (point-max))) - (if search-backwards - (let* ((end (or (previous-single-property-change - (if (eq start-point (point-max)) - start-point - (1+ start-point)) - property) - ;; we may either be just before the range or there - ;; is nothing at all - (and (not (eq start-point (point-min))) - (get-text-property (1- start-point) property) - start-point))) - (start (and end (previous-single-property-change - end property nil (point-min))))) - (when end - (cons start end))) - (let* ((start (next-single-property-change start-point property)) - (end (and start (next-single-property-change - start property nil (point-max))))) - (when start - (cons start end)))))) - -(defun mastodon-tl--find-next-or-previous-property-range - (property start-point search-backwards) - "Find (start . end) property range after/before START-POINT. -Does so while PROPERTY is set to a consistent value (different -from the value at START-POINT if that is set). -Return nil if no such range exists. -If SEARCH-BACKWARDS is non-nil it find a region before -START-POINT otherwise after START-POINT." - (if (not (get-text-property start-point property)) - ;; If we are not within a range, we can just defer to - ;; mastodon-tl--find-property-range directly. - (mastodon-tl--find-property-range property start-point search-backwards) - ;; We are within a range, we need to start the search from - ;; before/after this range: - (let ((current-range - (mastodon-tl--find-property-range property start-point))) - (if search-backwards - (unless (eq (car current-range) (point-min)) - (mastodon-tl--find-property-range - property (1- (car current-range)) search-backwards)) - (unless (eq (cdr current-range) (point-max)) - (mastodon-tl--find-property-range - property (1+ (cdr current-range)) search-backwards)))))) - -(defun mastodon-tl--consider-timestamp-for-updates (timestamp) - "Take note that TIMESTAMP is used in buffer and ajust timers as needed. -This calculates the next time the text for TIMESTAMP will change -and may adjust existing or future timer runs should that time -before current plans to run the update function. -The adjustment is only made if it is significantly (a few -seconds) before the currently scheduled time. This helps reduce -the number of occasions where we schedule an update only to -schedule the next one on completion to be within a few seconds. -If relative timestamps are disabled (i.e. if -`mastodon-tl--enable-relative-timestamps' is nil), this is a -no-op." - (when mastodon-tl--enable-relative-timestamps - (let ((this-update (cdr (mastodon-tl--relative-time-details timestamp)))) - (when (time-less-p this-update - (time-subtract mastodon-tl--timestamp-next-update - (seconds-to-time 10))) - (setq mastodon-tl--timestamp-next-update this-update) - (when mastodon-tl--timestamp-update-timer - ;; We need to re-schedule for an earlier time - (cancel-timer mastodon-tl--timestamp-update-timer) - (setq mastodon-tl--timestamp-update-timer - (run-at-time (time-to-seconds (time-subtract this-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) nil))))))) - -(defun mastodon-tl--update-timestamps-callback (buffer previous-marker) - "Update the next few timestamp displays in BUFFER. -Start searching for more timestamps from PREVIOUS-MARKER or -from the start if it is nil." - ;; only do things if the buffer hasn't been killed in the meantime - (when (and mastodon-tl--enable-relative-timestamps ; just in case - (buffer-live-p buffer)) - (save-excursion - (with-current-buffer buffer - (let ((previous-timestamp (if previous-marker - (marker-position previous-marker) - (point-min))) - (iteration 0) - next-timestamp-range) - (if previous-marker - ;; a follow-up call to process the next batch of timestamps. - ;; Release the marker to not slow things down. - (set-marker previous-marker nil) - ;; Otherwise this is a rew run, so let's initialize the next-run time. - (setq mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300)) - mastodon-tl--timestamp-update-timer nil)) - (while (and (< iteration 5) - (setq next-timestamp-range - (mastodon-tl--find-property-range 'timestamp - previous-timestamp))) - (let* ((start (car next-timestamp-range)) - (end (cdr next-timestamp-range)) - (timestamp (get-text-property start 'timestamp)) - (current-display (get-text-property start 'display)) - (new-display (mastodon-tl--relative-time-description timestamp))) - (unless (string= current-display new-display) - (let ((inhibit-read-only t)) - (add-text-properties - start end - (list 'display - (mastodon-tl--relative-time-description timestamp))))) - (mastodon-tl--consider-timestamp-for-updates timestamp) - (setq iteration (1+ iteration) - previous-timestamp (1+ (cdr next-timestamp-range))))) - (if next-timestamp-range - ;; schedule the next batch from the previous location to - ;; start very soon in the future: - (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer - (copy-marker previous-timestamp)) - ;; otherwise we are done for now; schedule a new run for when needed - (setq mastodon-tl--timestamp-update-timer - (run-at-time (time-to-seconds - (time-subtract mastodon-tl--timestamp-next-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - buffer nil)))))))) - -(defun mastodon-tl--set-after-update-marker () - "Set `mastodon-tl--after-update-marker' to the after-update location. -This location is defined by a non-nil value of -`mastodon-tl-position-after-update'." - (if (not mastodon-tl-position-after-update) - (setq mastodon-tl--after-update-marker nil) - (let ((marker (make-marker))) - (set-marker marker - (cond - ((eq 'keep-point mastodon-tl-position-after-update) - (point)) - ((eq 'last-old-toot mastodon-tl-position-after-update) - (next-single-property-change - (or mastodon-tl--update-point (point-min)) - 'byline)) - (t - (error "Unknown mastodon-tl-position-after-update value %S" - mastodon-tl-position-after-update)))) - ;; Make the marker advance if text gets inserted there. - (set-marker-insertion-type marker t) - (setq mastodon-tl--after-update-marker marker)))) - -(defun mastodon-tl-update () - "Update timeline with new toots." - (interactive) - ;; FIXME: actually these buffers should just reload by calling their own - ;; load function (actually g is mostly mapped as such) - ;; well actually, g should be for reload, update is different. - (if (or (member (mastodon-tl--get-buffer-type) - '(trending-statuses - trending-tags - follow-suggestions - lists - filters - scheduled-statuses)) - (mastodon-tl--search-buffer-p)) - (user-error "Update not available in this view") - ;; FIXME: handle update for search and trending buffers - (let* ((endpoint (mastodon-tl--endpoint)) - (update-fun (mastodon-tl--update-function)) - (id (mastodon-tl--newest-id))) - ;; update a thread, without calling `mastodon-tl--updated-json': - (if (mastodon-tl--buffer-type-eq 'thread) - ;; load whole thread: - (progn (mastodon-tl--thread-do id) - (message "Loaded full thread.")) - (if (not id) ;; if e.g. notifs all cleared: - (user-error "No last id") - ;; update other timelines: - (let* ((params (mastodon-tl--update-params)) - (notifs-p - (eq update-fun 'mastodon-notifications--timeline)) - (json (mastodon-tl--updated-json - endpoint id params - (when (and notifs-p mastodon-group-notifications) - "v2")))) - (if (mastodon-tl--no-json json) - (user-error "Nothing to update") - (let ((inhibit-read-only t)) - (mastodon-tl--set-after-update-marker) - (goto-char (or mastodon-tl--update-point (point-min))) - (if notifs-p - (funcall update-fun json nil :update) - (funcall update-fun json)) - (if mastodon-tl--after-update-marker - (goto-char mastodon-tl--after-update-marker) - (mastodon-tl-goto-next-item)))))))))) - - -;;; LOADING TIMELINES - -(defun mastodon-tl--init - (buffer-name endpoint update-function &optional headers params - hide-replies instance no-byline) - "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. -UPDATE-FUNCTION is used to recieve more toots. -HEADERS means to also collect the response headers. Used for paginating -favourites and bookmarks. -PARAMS is any parameters to send with the request. -HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer. -INSTANCE is a string of another instance domain we are displaying -a timeline from. -NO-BYLINE means just insert toot body, used for announcements." - (let ((url (if instance - (concat "https://" instance "/api/v1/" endpoint) - (mastodon-http--api endpoint))) - (buffer (concat "*mastodon-" buffer-name "*"))) - (funcall - (if headers - #'mastodon-http--get-response-async - #'mastodon-http--get-json-async) - url params 'mastodon-tl--init* - buffer endpoint update-function headers params hide-replies - instance no-byline))) - -(defun mastodon-tl--init* - (response buffer endpoint update-function &optional headers - update-params hide-replies instance no-byline) - "Initialize BUFFER with timeline targeted by ENDPOINT. -UPDATE-FUNCTION is used to recieve more toots. -RESPONSE is the data returned from the server by -`mastodon-http--process-json', with arg HEADERS a cons cell of -JSON and http headers, without it just the JSON. -NO-BYLINE means just insert toot body, used for announcements." - (let ((json (if headers (car response) response))) - (cond ((not json) ; praying this is right here, else try "\n[]" - ;; this means that whatever tl was inited won't load, which is not - ;; always wanted, as sometimes you still need the page to load so - ;; you can be in eg mastodon-mode, have keymap, search etc. - (message "Looks like nothing returned from endpoint: %s" endpoint) - ;; if we are a new account, home tl may have nothing, but then - ;; this clause means we can never load mastodon.el at all! - ;; so as a fallback, load trending statuses: - ;; FIXME: this could possibly be a fallback for all timelines not - ;; just home? - (when (string= endpoint "timelines/home") - (mastodon-search-trending-statuses))) - ((eq (caar json) 'error) - (user-error "Looks like the server bugged out: \"%s\"" (cdar json))) - (t - (let* ((headers (when headers (cdr response))) - (link-header - (mastodon-tl--get-link-header-from-response headers))) - (with-mastodon-buffer buffer #'mastodon-mode nil - (mastodon-tl--set-buffer-spec - buffer endpoint update-function - link-header update-params hide-replies - ;; awful hack to fix multiple reloads: - (alist-get "max_id" update-params nil nil #'string=)) - (mastodon-tl--do-init json update-function instance no-byline))))))) - -(defun mastodon-tl--init-sync - (buffer-name endpoint update-function &optional note-type params - headers view-name binding-str endpoint-version) - "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. -UPDATE-FUNCTION is used to receive more toots. -Runs synchronously. -Optional arg NOTE-TYPE means only get that type of notification. -PARAMS is an alist of any params to include in the request. -HEADERS are any headers to send in the request. -VIEW-NAME is a string, to be used as a heading for the view. -BINDING-STR is a string explaining any bindins in the view, it can have -formatting for `substitute-command-keys'. -ENDPOINT-VERSION is a string, format Vx, e.g. V2." - ;; Used by `mastodon-notifications-get' and in views.el - (let* ((notes-params (when note-type - (mastodon-http--build-array-params-alist - "types[]" (list note-type)))) - (params (append notes-params params)) - (url (mastodon-http--api endpoint endpoint-version)) - (buffer (concat "*mastodon-" buffer-name "*")) - (response (mastodon-http--get-response url params)) - (json (car response)) - (headers (when headers (cdr response))) - (link-header (when headers - (mastodon-tl--get-link-header-from-response headers)))) - (with-mastodon-buffer buffer #'mastodon-mode nil - ;; insert view-name/ heading-str - (when view-name - (mastodon-search--insert-heading view-name)) - (when binding-str - (insert - (substitute-command-keys - (mastodon-tl--set-face (concat "[" binding-str "]\n\n") - 'mastodon-toot-docs-face)))) - (mastodon-tl--set-buffer-spec - buffer endpoint update-function - link-header params nil - ;; awful hack to fix multiple reloads: - (alist-get "max_id" params nil nil #'string=)) - (mastodon-tl--do-init json update-function nil nil note-type) - buffer))) - -(defun mastodon-tl--do-init (json update-fun &optional domain no-byline type) - "Utility function for `mastodon-tl--init*' and `mastodon-tl--init-sync'. -JSON is the data to call UPDATE-FUN on. -When DOMAIN, force inclusion of user's domain in their handle. -NO-BYLINE means just insert toot body, used for announcements. -TYPE is a notification type." - (remove-overlays) ; video overlays - (cond (domain ;; maybe our update-fun doesn't always have 3 args...: - (funcall update-fun json nil domain)) - (type (funcall update-fun json type)) ;; notif types - (no-byline (funcall update-fun json nil nil no-byline)) - (t (funcall update-fun json))) - (setq - ;; Initialize with a minimal interval; we re-scan at least once - ;; every 5 minutes to catch any timestamps we may have missed - mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300))) - (setq mastodon-tl--timestamp-update-timer - (when mastodon-tl--enable-relative-timestamps - (run-at-time (time-to-seconds - (time-subtract mastodon-tl--timestamp-next-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil))) - (unless (mastodon-tl--profile-buffer-p) - (mastodon-tl--goto-first-item))) - -;;; NODEINFO - -(defun mastodon-tl--get-nodeinfo (instance &optional version) - "Return Nodeinfo data for INSTANCE, optionally for version." - ;; NB: not in the API: - (let ((url (format "https://%s/nodeinfo/%s" instance (or version "2.0")))) - (mastodon-http--get-json url))) - -(defun mastodon-tl-nodeinfo-for-toot () - "Return Nodeinfo for toot at point. -Displays what software and version an instance is running. -Also the instances description and usage stats, etc. -Nodeinfo is a data standard for distributed social networks, see -https://nodeinfo.diaspora.software." - (interactive) - (let* ((item (mastodon-tl--property 'item-json)) - (url (mastodon-tl--field 'url item)) - (instance (url-host (url-generic-parse-url url))) - (data (mastodon-tl--get-nodeinfo instance))) - (when data ;; don't display empty message when fetching failed - (if (eq 'error (caar data)) - (user-error "Error: %s" (alist-get 'error data)) - (mastodon-tl--render-nodeinfo data))))) - -(defun mastodon-tl--render-nodeinfo (data) - "Render Nodeinfo DADA as message." - (let-alist data - (message - "%s" - (concat "Software: " - .software.name " " .software.version - (if (not .metadata) - "" - (concat - "\nInstance: " - .metadata.nodeName " " .metadata.nodeDescription)))))) - -;;; BOOKMARKS - -(require 'bookmark) - -(defun mastodon-tl--bookmark-handler (record) - "Jump to a bookmarked location in mastodon.el. -RECORD is the bookmark record." - (let ((id (bookmark-prop-get record 'id))) - ;; we need to handle thread and single toot for starters - (pop-to-buffer - (mastodon-tl--thread-do id)))) - -(defun mastodon-tl--bookmark-make-record () - "Return a bookmark record for the current mastodon buffer." - (let ((id (mastodon-tl--property 'item-id :no-move)) - (name (buffer-name))) - `(,name - (buf . ,name) - (id . ,id) - (handler . mastodon-tl--bookmark-handler)))) - -(add-hook 'mastodon-mode-hook - (lambda () - (setq-local bookmark-make-record-function - #'mastodon-tl--bookmark-make-record))) - -(provide 'mastodon-tl) -;;; mastodon-tl.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-toot.el b/elpa/mastodon-20251201.1553/mastodon-toot.el deleted file mode 100644 index 463abe34..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-toot.el +++ /dev/null @@ -1,2133 +0,0 @@ -;;; 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 -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; Commentary: - -;; mastodon-toot.el supports POSTing status data to Mastodon. - -;;; Code: -(eval-when-compile (require 'subr-x)) - - -(defvar mastodon-use-emojify) -(require 'emojify nil :noerror) -(declare-function emojify-insert-emoji "emojify") -(declare-function emojify-set-emoji-data "emojify") -(declare-function emojify-mode "emojify") -(declare-function emojify-emojis-each "emojify") -(defvar emojify-emojis-dir) -(defvar emojify-user-emojis) -(defvar emojify-emoji-styles) - -(require 'cl-lib) -(require 'persist) -(require 'mastodon-iso) -(require 'facemenu) -(require 'text-property-search) - -(eval-when-compile - (require 'mastodon-tl)) - -(defvar mastodon-instance-url) -(defvar mastodon-tl--buffer-spec) -(defvar mastodon-tl--enable-proportional-fonts) -(defvar mastodon-profile-account-settings) -(defvar mastodon-profile-acccount-preferences-data) - -(autoload 'iso8601-parse "iso8601") -(autoload 'ht-get "ht") -(autoload 'mastodon-auth--user-acct "mastodon-auth") -(autoload 'mastodon-http--api "mastodon-http") -(autoload 'mastodon-http--build-array-params-alist "mastodon-http") -(autoload 'mastodon-http--delete "mastodon-http") -(autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-http--get-json-async "mastodon-http") -(autoload 'mastodon-http--post "mastodon-http") -(autoload 'mastodon-http--post-media-attachment "mastodon-http") -(autoload 'mastodon-http--process-json "mastodon-http") -(autoload 'mastodon-http--put "mastodon-http") -(autoload 'mastodon-http--read-file-as-string "mastodon-http") -(autoload 'mastodon-http--triage "mastodon-http") -(autoload 'mastodon-kill-window "mastodon") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") -(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") -(autoload 'mastodon-profile--get-source-pref "mastodon-profile") -(autoload 'mastodon-profile-show-user "mastodon-profile") -(autoload 'mastodon-profile--update-preference "mastodon-profile") -(autoload 'mastodon-search--search-accounts-query "mastodon-search") -(autoload 'mastodon-search--search-tags-query "mastodon-search") -(autoload 'mastodon-tl--as-string "mastodon-tl") -(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") -(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") -(autoload 'mastodon-tl--field "mastodon-tl") -(autoload 'mastodon-tl--find-property-range "mastodon-tl") -(autoload 'mastodon-tl--find-property-range "mastodon-tl") -(autoload 'mastodon-tl-goto-next-item "mastodon-tl") -(autoload 'mastodon-tl--map-alist "mastodon-tl") -(autoload 'mastodon-tl--property "mastodon-tl") -(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") -(autoload 'mastodon-tl--render-text "mastodon-tl") -(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") -(autoload 'mastodon-tl--symbol "mastodon-tl") -(autoload 'mastodon-tl--item-id "mastodon-tl") -(autoload 'mastodon-toot "mastodon") -(autoload 'mastodon-views-cancel-scheduled-toot "mastodon-views") -(autoload 'mastodon-views-view-scheduled-toots "mastodon-views") -(autoload 'org-read-date "org") -(autoload 'mastodon-tl--toot-or-base "mastodon-tl") -(autoload 'mastodon-profile--get-source-value "mastodon-toot") -(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") -(autoload 'mastodon-tl--human-duration "mastodon-tl") -(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") -(autoload 'mastodon-views--get-own-instance "mastodon-views") -(autoload 'mastodon-tl--image-trans-check "mastodon-tl") -(autoload 'mastodon-instance-data "mastodon") -(autoload 'mastodon-create-poll "mastodon-transient") -(autoload 'mastodon-tl--own-profile-buffer-p "mastodon-tl") - -;; for mastodon-toot-translate-toot-text -(autoload 'mastodon-tl--content "mastodon-tl") -(when (require 'lingva nil :no-error) - (declare-function lingva-translate "lingva")) - -(defgroup mastodon-toot nil - "Tooting in Mastodon." - :prefix "mastodon-toot-" - :group 'mastodon) - -(defcustom mastodon-toot--default-media-directory "~/" - "The default directory when prompting for a media file to upload." - :type 'string) - -(defcustom mastodon-toot--attachment-height 80 - "Height of the attached images preview in the toot draft buffer." - :type 'integer) - -(defcustom mastodon-toot--enable-completion t - "Whether to enable completion of mentions and hashtags. -Used for completion in toot compose buffer." - :type 'boolean) - -(defcustom mastodon-toot--use-company-for-completion nil - "Whether to enable company for completion. -When non-nil, `company-mode' is enabled in the toot compose -buffer, and mastodon completion backends are added to -`company-capf'. - -You need to install company yourself to use this." - :type 'boolean) - -(defcustom mastodon-toot--completion-style-for-mentions "all" - "The company completion style to use for mentions." - :type '(choice - (const :tag "off" nil) - (const :tag "following only" "following") - (const :tag "all users" "all"))) - -(defcustom mastodon-toot-display-orig-in-reply-buffer nil - "Display a copy of the toot replied to in the compose buffer." - :type 'boolean) - -(defcustom mastodon-toot-orig-in-reply-length 191 - ;; three lines of divider width: (- (* 3 67) (length " Reply to: ")) - "Length to crop toot replied to in the compose buffer to." - :type 'integer) - -(defcustom mastodon-toot--default-reply-visibility "public" - "Default visibility settings when replying. -If the original toot visibility is different we use the more restricted one." - :type '(choice - (const :tag "public" "public") - (const :tag "unlisted" "unlisted") - (const :tag "followers only" "private") - (const :tag "direct" "direct"))) - -(defcustom mastodon-toot--enable-custom-instance-emoji nil - "Whether to enable your instance's custom emoji by default." - :type 'boolean) - -(defcustom mastodon-toot--proportional-fonts-compose nil - "Nonnil to enable using proportional fonts in the compose buffer. -By default fixed width fonts are used." - :type '(boolean :tag "Enable using proportional rather than fixed \ -width fonts")) - -(defcustom mastodon-toot-poll-use-transient t - "Whether to use the transient menu to create a poll." - :type '(boolean)) - -(defvar-local mastodon-toot--content-warning nil - "The content warning of the current toot.") - -(defvar-local mastodon-toot--content-nsfw nil - "A flag indicating whether the toot should be marked as NSFW.") - -(defvar mastodon-toot-visibility-list - '(public unlisted private direct) - "A list of the available toot visibility settings.") - -(defvar mastodon-toot-visibility-settings-list - '("public" "unlisted" "private") - "A list of the available default toot visibility settings. -Like `mastodon-toot-visibility-list' but without direct.") - -(defvar-local mastodon-toot--visibility nil - "A string indicating the visibility of the toot being composed. -Valid values are \"direct\", \"private\" (followers-only), -\"unlisted\", and \"public\". - -This is determined by the account setting on the server. To -change the setting on the server, see -`mastodon-toot-set-default-visibility'.") - -(defvar-local mastodon-toot--media-attachments nil - "A list of the media attachments of the toot being composed.") - -(defvar-local mastodon-toot--media-attachment-ids nil - "A list of any media attachment ids of the toot being composed.") - -(defvar mastodon-toot-poll nil - "A plist of poll options for the toot being composed.") - -(defvar-local mastodon-toot--language nil - "The language of the toot being composed, in ISO 639 (two-letter).") - -(defvar-local mastodon-toot--scheduled-for nil - "An ISO 8601 timestamp that specifying when the post should be published. -Should be at least 5 minutes into the future.") - -(defvar-local mastodon-toot--scheduled-id nil - "The id of the scheduled post that we are now editing.") - -(defvar-local mastodon-toot--reply-to-id nil - "Buffer-local variable to hold the id of the toot being replied to.") - -(defvar-local mastodon-toot--edit-item-id nil - "The id of the toot being edited.") - -(defvar-local mastodon-toot-previous-window-config nil - "A list of window configuration prior to composing a toot. -Takes its form from `window-configuration-to-register'.") - -(defvar mastodon-toot--max-toot-chars nil - "The maximum allowed characters count for a single toot.") - -(defvar-local mastodon-toot-completions nil - "The data of completion candidates for the current completion at point.") - -(defvar mastodon-toot-current-toot-text nil - "The text of the toot being composed.") - -(persist-defvar mastodon-toot-draft-toots-list nil - "A list of toots that have been saved as drafts. -For the moment we just put all composed toots in here, as we want -to also capture toots that are \"sent\" but that don't successfully -send.") - - -;;; REGEXES - -(defvar mastodon-toot-handle-regex - (rx (group-n 2 ; include domain - (group-n 4 ; exclude domain - (| (any ?\( "\n" "\t" " ") bol) ; preceding things - ?@ ; first @ - (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; username - (? ?@ (* (not (any "\n" "\t" " "))))) ; optional domain - (| "'" word-boundary))) ; boundary or possessive - -(defvar mastodon-toot-tag-regex - (rx (| (any ?\( "\n" "\t" " ") bol) - (group-n 2 ?# (+ (any "_" "A-Z" "a-z" "0-9"))) - (| "'" word-boundary))) ; boundary or possessive - -(defvar mastodon-toot-emoji-regex - (rx (| (any ?\( "\n" "\t" " ") bol) - (group-n 2 ?: ; opening : - (+ (any "A-Z" "a-z" "0-9" "_")) - (? ?:)) ; closing : - word-boundary)) ; boundary - -(defvar mastodon-toot-url-regex - ;; adapted from ffap-url-regexp - (concat - "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix - "[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars - ;; "[ .,:;!?]\\b")) - ;; "/" ; poss an ending slash? incompat with boundary end: - "\\>")) ; boundary end - - -;;; 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))) - - -;;; 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))) - - -;;; MODE MAP - -(defvar mastodon-toot-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") #'mastodon-toot-send) - (define-key map (kbd "C-c C-k") #'mastodon-toot-cancel) - (define-key map (kbd "C-c C-w") #'mastodon-toot-set-content-warning) - (define-key map (kbd "C-c C-n") #'mastodon-toot-toggle-nsfw) - (define-key map (kbd "C-c C-v") #'mastodon-toot-change-visibility) - (define-key map (kbd "C-c C-e") #'mastodon-toot-insert-emoji) - (define-key map (kbd "C-c C-a") #'mastodon-toot-attach-media) - (define-key map (kbd "C-c !") #'mastodon-toot-clear-all-attachments) - (define-key map (kbd "C-c C-p") #'mastodon-toot-create-poll) - (define-key map (kbd "C-c C-o") #'mastodon-toot-clear-poll) - (define-key map (kbd "C-c C-l") #'mastodon-toot-set-toot-language) - (define-key map (kbd "C-c C-s") #'mastodon-toot-schedule-toot) - map) - "Keymap for `mastodon-toot'.") - -(defun mastodon-toot-set-default-visibility () - "Set the default visibility for toots on the server." - (interactive) - (let ((vis (completing-read "Set default visibility to:" - mastodon-toot-visibility-list - nil t))) - (mastodon-profile--update-preference "privacy" vis :source))) - -(defun mastodon-toot--get-max-toot-chars (&optional no-toot) - "Fetch max_toot_chars from `mastodon-instance-url' asynchronously. -NO-TOOT means we are not calling from a toot buffer." - (mastodon-http--get-json-async - (mastodon-http--api "instance") - nil - 'mastodon-toot--get-max-toot-chars-callback no-toot)) - -(defun mastodon-toot--get-max-toot-chars-callback (json-response - &optional no-toot) - "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer. -NO-TOOT means we are not calling from a toot buffer." - (let ((max-chars - (or (alist-get 'max_toot_chars json-response) - (alist-get 'max_characters ; some servers have this instead - (alist-get 'statuses - (alist-get 'configuration - json-response)))))) - (setq mastodon-toot--max-toot-chars max-chars) - (unless no-toot - (with-current-buffer "*new toot*" - (mastodon-toot--update-status-fields))))) - -(defun mastodon-toot--action-success (marker byline-region remove &optional json) - "Insert/remove the text MARKER with `success' face in byline. -BYLINE-REGION is a cons of start and end pos of the byline to be -modified. -Remove MARKER if REMOVE is non-nil, otherwise add it. -JSON is added to the string as its item-json." - (let ((inhibit-read-only t) - (bol (car byline-region)) - (eol (cdr byline-region)) - (at-byline-p (eq t (mastodon-tl--property 'byline :no-move)))) - (save-excursion - (when remove - (goto-char bol) - (beginning-of-line) ;; The marker is not part of the byline - (if (search-forward (format "(%s) " marker) eol :no-error) - (replace-match "") - (user-error "Oops: could not find marker '(%s)'" marker))) - (unless remove - (goto-char bol) - (insert - (propertize - (format "(%s) " - (propertize marker - 'face 'success)) - 'cursor-face 'mastodon-cursor-highlight-face - 'item-json json)))) ;; for (un)folding items - (when at-byline-p - ;; leave point after the marker: - (unless remove - ;; if point is inside the byline, back up first so - ;; we don't move to the following toot: - (beginning-of-line) - (forward-line -1) - (mastodon-tl-goto-next-item))))) - -(defun mastodon-toot--action (action callback) - "Take ACTION, a string, on toot at point, then execute CALLBACK. -Makes a POST request to the server. Used for favouriting, -boosting, or bookmarking toots." - (let* ((id (mastodon-tl--property 'base-item-id)) - (url (mastodon-http--api - (concat "statuses/" (mastodon-tl--as-string id) "/" action))) - (response (mastodon-http--post url))) - (mastodon-http--triage response callback))) - -(defun mastodon-toot--toggle-boost-or-favourite (action) - "Toggle boost or favourite of toot at point. -ACTION is a symbol, either `favourite' or `boost.'" - (mastodon-toot--with-toot-item - (let* ((n-type (mastodon-tl--property 'notification-type :no-move)) - (byline-region (mastodon-tl--find-property-range 'byline (point))) - (boost-p (eq action 'boost)) - (action-str (symbol-name action)) - (item-json (mastodon-tl--property 'item-json)) - (vis (mastodon-tl--field 'visibility item-json))) - (cond - ((not byline-region) - (user-error "Nothing to %s here?!?" action-str)) - ;; there's nothing wrong with faving/boosting own toots - ;; & nothing wrong with faving/boosting own toots from notifs, - ;; it boosts/faves the base toot, not the notif status - ((or (string= n-type "follow") - (string= n-type "follow_request")) - (user-error "Can't %s %s notifications" action n-type)) - ((and boost-p - (or (string= vis "direct") - (string= vis "private"))) - (user-error "Can't boost posts with visibility: %s" vis)) - (t - (let* ((boosted (when byline-region - (get-text-property (car byline-region) 'boosted-p))) - (faved (when byline-region - (get-text-property (car byline-region) 'favourited-p))) - (str-api (if boost-p "reblog" action-str)) - (action-str-api (mastodon-toot--str-negify str-api faved boosted - action)) - (action-pp (concat - (mastodon-toot--str-negify action-str faved boosted - action) - (if boost-p "ed" "d"))) - (remove-p (if boost-p boosted faved))) - (mastodon-toot--action - action-str-api - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (if boost-p - (list 'boosted-p (not boosted)) - (list 'favourited-p (not faved)))) - (mastodon-toot--update-stats-on-action action remove-p) - (mastodon-toot--action-success (mastodon-tl--symbol action) - byline-region remove-p item-json)) - (message "%s #%s" action-pp id))))))))) - -(defun mastodon-toot--str-negify (str faved boosted action) - "Add \"un\" to STR if item is already FAVED or BOOSTED. -ACTION is the action currently being taken." - (if (eq action 'boost) - (if boosted (concat "un" str) str) - (if faved - (concat "un" str) - str))) - -(defun mastodon-toot--update-stats-on-action (action &optional subtract) - "Increment the toot stats display upon ACTION. -ACTION is a symbol, either `favourite' or `boost'. -SUBTRACT means we are un-favouriting or unboosting, so we decrement." - (if (not (symbolp action)) - (error "Invalid argument: symbolp %s" action) - (let* ((count-prop (if (eq action 'favourite) - 'favourites-count - 'boosts-count)) - (count-range (mastodon-tl--find-property-range count-prop (point))) - (count (get-text-property (car count-range) count-prop)) - (inhibit-read-only 1)) - ;; TODO another way to implement this would be to async fetch counts again - ;; and re-display from count-properties - (add-text-properties (car count-range) - (cdr count-range) - (list 'display - (number-to-string - (mastodon-toot--inc-or-dec count subtract)) - ;; update the count prop - ;; we rely on this for any subsequent actions: - count-prop - (mastodon-toot--inc-or-dec count subtract)))))) - -(defun mastodon-toot-toggle-boost () - "Boost/unboost toot at `point'." - (interactive) - (mastodon-toot--toggle-boost-or-favourite 'boost)) - -(defun mastodon-toot-toggle-favourite () - "Favourite/unfavourite toot at `point'." - (interactive) - (mastodon-toot--toggle-boost-or-favourite 'favourite)) - -;; TODO maybe refactor into boost/fave fun -(defun mastodon-toot-toggle-bookmark () - "Bookmark or unbookmark toot at point." - (interactive) - (mastodon-toot--with-toot-item - (let* ((n-type (mastodon-tl--property 'notification-type :no-move)) - (byline-region (mastodon-tl--find-property-range 'byline (point))) - (bookmarked-p (when byline-region - (get-text-property (car byline-region) 'bookmarked-p))) - (action (if bookmarked-p "unbookmark" "bookmark"))) - (cond ((or (string= n-type "follow") - (string= n-type "follow_request")) - (user-error "Can't bookmark %s notifications" n-type)) - ((not byline-region) - (user-error "Nothing to %s here?!?" action)) - (t - (let* ((bookmark-str (mastodon-tl--symbol 'bookmark)) - (message (if bookmarked-p - "Bookmark removed!" - "Toot bookmarked!")) - (item-json (mastodon-tl--property 'item-json))) - (mastodon-toot--action - action - (lambda (_) - (let ((inhibit-read-only t)) - (add-text-properties (car byline-region) - (cdr byline-region) - (list 'bookmarked-p (not bookmarked-p))) - (mastodon-toot--action-success bookmark-str - byline-region bookmarked-p item-json) - (message "%s #%s" message id)))))))))) - -(defun mastodon-toot-list-boosters () - "List the boosters of toot at point." - (interactive) - ;; use grouped notifs data if present: - ;; only send accounts as arg if type matches notif type we are acting - ;; on, to prevent showing accounts for a boost notif when asking for - ;; favers, and vice versa. - (let* ((type (mastodon-tl--property 'notification-type :no-move)) - (accounts (when (string= type "reblog") - (mastodon-tl--property 'notification-accounts :no-move)))) - (mastodon-toot--list-boosters-or-favers nil accounts))) - -(defun mastodon-toot-list-favouriters () - "List the favouriters of toot at point." - (interactive) - (let* ((type (mastodon-tl--property 'notification-type :no-move)) - (accounts (when (string= type "favourite") - (mastodon-tl--property 'notification-accounts :no-move)))) - (mastodon-toot--list-boosters-or-favers :favourite accounts))) - -(defun mastodon-toot--list-boosters-or-favers (&optional favourite accounts) - "List the favouriters or boosters of toot at point. -With FAVOURITE, list favouriters, else list boosters. -ACCOUNTS is notfications accounts if any." - (mastodon-toot--with-toot-item - (let* ((endpoint (unless accounts - (if favourite "favourited_by" "reblogged_by"))) - (url (unless accounts - (mastodon-http--api (format "statuses/%s/%s" id endpoint)))) - (params (unless accounts '(("limit" . "80")))) - (json (or accounts (mastodon-http--get-json url params)))) - (if (eq (caar json) 'error) - (user-error "%s (Status does not exist or is private)" - (alist-get 'error json)) - (let ((handles (mastodon-tl--map-alist 'acct json)) - (type-string (if favourite "Favouriters" "Boosters"))) - (if (not handles) - (user-error "Looks like this toot has no %s" type-string) - (let ((choice (completing-read - (format "%s (enter to view profile): " type-string) - handles nil t))) - (mastodon-profile-show-user choice)))))))) - -(defun mastodon-toot-copy-toot-url () - "Copy URL of toot at point. -If the toot is a fave/boost notification, copy the URL of the -base toot." - (interactive) - (let* ((url (mastodon-toot--toot-url))) - (kill-new url) - (message "Toot URL copied to the clipboard."))) - -(defun mastodon-toot-browse-toot-url () - "Browse URL of toot at point. -Calls `browse-url'." - (interactive) - (browse-url - (mastodon-toot--toot-url))) - -(defun mastodon-toot--toot-url () - "Return the URL of the base toot at point." - (let* ((toot (mastodon-toot--base-toot-or-item-json))) - (if (mastodon-tl--field 'reblog toot) - (alist-get 'url (alist-get 'reblog toot)) - (alist-get 'url toot)))) - -(defun mastodon-toot-copy-toot-text () - "Copy text of toot at point. -If the toot is a fave/boost notification, copy the text of the -base toot." - (interactive) - (let* ((toot (mastodon-toot--base-toot-or-item-json))) - (kill-new (mastodon-tl--content toot)) - (message "Toot content copied to the clipboard."))) - -(defun mastodon-toot-translate-toot-text () - "Translate text of toot at point. -Uses `lingva.el'." - (interactive) - (if mastodon-tl--buffer-spec - (if-let* ((toot (mastodon-tl--property 'item-json))) - (condition-case x - (lingva-translate nil - (mastodon-tl--content toot) - (when mastodon-tl--enable-proportional-fonts - t)) - (void-function - (user-error "Looks like you need to install lingva.el. Error: %s" - (error-message-string x)))) - (user-error "No toot to translate?")) - (user-error "No mastodon buffer?"))) - -(defun mastodon-toot--own-toot-p (toot) - "Check if TOOT is user's own, for deleting, editing, or pinning it." - ;; this check needs to allow acting on own toots displayed as boosts, so we - ;; call `mastodon-tl--toot-or-base'. - (let ((json (mastodon-tl--toot-or-base toot))) - (string= (alist-get 'acct (alist-get 'account json)) - (mastodon-auth--user-acct)))) - -(defun mastodon-toot-pin-toot-toggle () - "Pin or unpin user's toot at point." - (interactive) - (let* ((toot (mastodon-toot--base-toot-or-item-json)) - (pinnable-p (mastodon-toot--own-toot-p toot)) - (pinned-p (eq t (alist-get 'pinned toot))) - (action (if pinned-p "unpin" "pin")) - (msg (if pinned-p "unpinned" "pinned"))) - (if (not pinnable-p) - (user-error "You can only pin your own toots") - (when (y-or-n-p (format "%s this toot? " (capitalize action))) - (mastodon-toot--action - action - (lambda (_) - ;; let's only reload when in own profile view: - (when (mastodon-tl--own-profile-buffer-p) - (mastodon-tl--reload-timeline-or-profile)) - (message "Toot %s!" msg))))))) - - -;;; 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))) - - -;;; 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))))) - - -;;; EMOJIS - -(defun mastodon-toot-insert-emoji () - "Prompt to insert an emoji." - (interactive) - (if mastodon-use-emojify - (emojify-insert-emoji) - (call-interactively #'emoji-search))) ;; 29.1 - -(defun mastodon-toot--emoji-dir () - "Return the file path for the mastodon custom emojis directory." - (concat (expand-file-name emojify-emojis-dir) - "/mastodon-custom-emojis/")) - -(defun mastodon-toot-download-custom-emoji () - "Download `mastodon-instance-url's custom emoji. -Emoji images are stored in a subdir of `emojify-emojis-dir'. -To use the downloaded emoji, run `mastodon-toot-enable-custom-emoji'." - (interactive) - (let* ((url (mastodon-http--api "custom_emojis")) - (custom-emoji (mastodon-http--get-json url)) - (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) - (if (not (file-directory-p emojify-emojis-dir)) - (user-error "Looks like you need to set up emojify first") - (unless (file-directory-p mastodon-custom-emoji-dir) - (make-directory mastodon-custom-emoji-dir nil)) ; no add parent - (cl-loop for x in custom-emoji - do (let ((url (alist-get 'url x)) - (shortcode (alist-get 'shortcode x))) - ;; skip anything that contains unexpected characters - (when (and url shortcode - (string-match-p "^[a-zA-Z0-9-_]+$" shortcode) - (string-match-p "^[a-zA-Z]+$" (file-name-extension url))) - (url-copy-file url - (concat mastodon-custom-emoji-dir - shortcode - "." - (file-name-extension url)) - t)))) - (message "Custom emoji for %s downloaded to %s" - mastodon-instance-url - mastodon-custom-emoji-dir)))) - -(defun mastodon-toot--collect-custom-emoji () - "Return a list of `mastodon-instance-url's custom emoji. -The list is formatted for `emojify-user-emojis', which see." - (let* ((mastodon-custom-emojis-dir (mastodon-toot--emoji-dir)) - (custom-emoji-files (directory-files mastodon-custom-emojis-dir - nil ; not full path - "^[^.]")) ; no dot files - mastodon-emojify-user-emojis) - (cl-loop for x in custom-emoji-files - do (push - `(,(concat ":" - (file-name-base x) ":") - . (("name" . ,(file-name-base x)) - ("image" . ,(concat mastodon-custom-emojis-dir x)) - ("style" . "github"))) - mastodon-emojify-user-emojis)) - (reverse mastodon-emojify-user-emojis))) - -(defun mastodon-toot-enable-custom-emoji () - "Add `mastodon-instance-url's custom emoji to `emojify'. -Custom emoji must first be downloaded with -`mastodon-toot-download-custom-emoji'. Custom emoji are appended -to `emojify-user-emojis', and the emoji data is updated." - (interactive) - (unless (file-exists-p (mastodon-toot--emoji-dir)) - (when (y-or-n-p "Looks like you haven't downloaded your - instance's custom emoji yet. Download now? ") - (mastodon-toot-download-custom-emoji))) - (let ((masto-emojis (mastodon-toot--collect-custom-emoji))) - (unless (cl-find (car masto-emojis) - emojify-user-emojis - :test #'equal) - (setq emojify-user-emojis - (append masto-emojis - emojify-user-emojis)) - ;; if already loaded, reload - (when (featurep 'emojify) - ;; we now only do this within the unless test above, as it is extremely - ;; slow and runs in `mastodon-mode-hook'. - (emojify-set-emoji-data))))) - -(defun mastodon-toot--remove-docs () - "Get the body of a toot from the current compose buffer." - (let ((header-region (mastodon-tl--find-property-range 'toot-post-header - (point-min)))) - (string-trim-left - (buffer-substring (cdr header-region) (point-max))))) - -(defun mastodon-toot--build-poll-params () - "Return an alist of parameters for POSTing a poll status." - (if mastodon-toot-poll-use-transient - (let-alist mastodon-toot-poll - (append - (mastodon-http--build-array-params-alist - "poll[options][]" - (list .one .two .three .four)) - (list (cons "poll[expires_in]" .expiry) - (cons "poll[multiple]" .multi) - (cons "poll[hide_totals]" .hide)))) - (append - (mastodon-http--build-array-params-alist - "poll[options][]" - (plist-get mastodon-toot-poll :options)) - `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) - `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) - `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide))))))) - - -;;; SEND TOOT FUNCTION - -(defun mastodon-toot-send () - "POST contents of new-toot buffer to fediverse instance and kill buffer. -If media items have been attached and uploaded with -`mastodon-toot-attach-media', they are attached to the toot. -If `mastodon-toot--edit-item-id' is non-nil, PUT contents to -instance to edit a toot." - (interactive) - (let* ((toot (mastodon-toot--remove-docs)) - (scheduled mastodon-toot--scheduled-for) - (scheduled-id mastodon-toot--scheduled-id) - (edit-id mastodon-toot--edit-item-id) - (endpoint (mastodon-http--api (if edit-id ; we are sending an edit: - (format "statuses/%s" edit-id) - "statuses"))) - (args-no-media - (append - `(("status" . ,toot) - ("in_reply_to_id" . ,mastodon-toot--reply-to-id) - ("visibility" . ,mastodon-toot--visibility) - ("sensitive" . ,(when mastodon-toot--content-nsfw - (symbol-name t))) - ("spoiler_text" . ,mastodon-toot--content-warning) - ("language" . ,mastodon-toot--language)) - ;; Pleroma instances can't handle null-valued - ;; scheduled_at args, so only add if non-nil - (when scheduled `(("scheduled_at" . ,scheduled))))) - (args-media (when mastodon-toot--media-attachment-ids - (mastodon-http--build-array-params-alist - "media_ids[]" - mastodon-toot--media-attachment-ids))) - (args-poll (when mastodon-toot-poll - (mastodon-toot--build-poll-params))) - ;; media || polls: - (args (if mastodon-toot--media-attachment-ids - (append args-media args-no-media) - (if mastodon-toot-poll - (append args-no-media args-poll) - args-no-media))) - (prev-window-config mastodon-toot-previous-window-config)) - (cond ((and mastodon-toot--media-attachment-ids - ;; make sure we have media args - ;; and the same num of ids as attachments - (or (not args-media) - (not (= (length mastodon-toot--media-attachments) - (length mastodon-toot--media-attachment-ids))))) - (user-error "Something is wrong with your uploads. Wait for them to complete or try again")) - ((and mastodon-toot--max-toot-chars - (> (mastodon-toot--count-toot-chars toot mastodon-toot--content-warning) - mastodon-toot--max-toot-chars)) - (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length")) - ;; polls must have text, so we use poll as flag for text-only - ;; check here: - ((mastodon-toot--empty-p mastodon-toot-poll) - (user-error "Empty toot. Cowardly refusing to post this")) - (t - (let ((response (funcall (if edit-id ; we are sending an edit: - #'mastodon-http--put - #'mastodon-http--post) - endpoint args))) - (mastodon-http--triage - response - (lambda (_) - ;; kill buffer: - (mastodon-toot--kill) - ;; nil our poll var: - (setq mastodon-toot-poll nil) - (message "Toot %s!" (if scheduled "scheduled" "toot")) - ;; cancel scheduled toot if we were editing it: - (when scheduled-id - (mastodon-views-cancel-scheduled-toot - scheduled-id :no-confirm)) - ;; window config: - (mastodon-toot--restore-previous-window-config prev-window-config) - ;; reload: - when we have been editing - ;; - when we are in thread view - ;; (we don't reload in every case as it can be slow and we - ;; may lose our place in a timeline.) - (let ((type (mastodon-tl--get-buffer-type))) - (when (or edit-id - (eq 'single-status type) - (eq 'thread type)) - (let ((pos (marker-position (cadr prev-window-config)))) - (mastodon-tl--reload-timeline-or-profile pos))))))))))) - - -;;; EDITING TOOTS: - -(defun mastodon-toot-edit-toot-at-point () - "Edit the user's toot at point." - (interactive) - (mastodon-toot--with-toot-item - (let ((toot (mastodon-toot--base-toot-or-item-json))) - (if (not (mastodon-toot--own-toot-p toot)) - (user-error "You can only edit your own toots") - (let* ((source (mastodon-toot--get-toot-source id)) - (content (alist-get 'text source)) - (source-cw (alist-get 'spoiler_text source))) - (let-alist toot - (when (y-or-n-p "Edit this toot? ") - (mastodon-toot--compose-buffer nil .in_reply_to_id nil - content :edit) - (goto-char (point-max)) - ;; adopt reply-to-id, visibility, CW, language, and media: - (mastodon-toot--set-toot-properties .in_reply_to_id .visibility - source-cw .language nil nil - ;; maintain media order: - (reverse .media_attachments) .poll) - (setq mastodon-toot--edit-item-id id)))))))) - -(defun mastodon-toot--get-toot-source (id) - "Fetch the source JSON of toot with ID." - (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) - (mastodon-http--get-json url nil :silent))) - -(defun mastodon-toot--get-toot-edits (id) - "Return the edit history of toot with ID." - (let* ((url (mastodon-http--api (format "statuses/%s/history" id)))) - (mastodon-http--get-json url))) - -(defun mastodon-toot-view-toot-edits () - "View editing history of the toot at point in a popup buffer." - (interactive) - (let ((id (mastodon-tl--property 'base-item-id)) - (history (mastodon-tl--property 'edit-history)) ;; at byline - (buf "*mastodon-toot-edits*")) - (if (not history) - (user-error "No editing history for this toot") - (with-mastodon-buffer buf #'special-mode :other-window - (cl-loop for count from 1 - for x in history - do (insert (propertize (if (= count 1) - (format "%s [original]:\n" count) - (format "%s:\n" count)) - 'face 'mastodon-toot-docs-face) - (mastodon-toot--insert-toot-iter x) - "\n")) - (goto-char (point-min)) - (setq-local header-line-format - (propertize - (format "Edits to toot by %s:" - (alist-get 'username - (alist-get 'account (car history)))) - 'face 'mastodon-toot-docs-face)) - (mastodon-tl--set-buffer-spec (buffer-name (current-buffer)) - (format "statuses/%s/history" id) - nil))))) - -(defun mastodon-toot--insert-toot-iter (it) - "Insert iteration IT of toot." - (let ((content (alist-get 'content it))) - ;; TODO: handle polls, media - (mastodon-tl--render-text content))) - -(defun mastodon-toot--restore-previous-window-config (config) - "Restore the window CONFIG after killing the toot compose buffer. -Buffer-local variable `mastodon-toot-previous-window-config' holds the config." - (set-window-configuration (car config)) - (goto-char (cadr config))) - -(defun mastodon-toot--mentions-to-string (mentions) - "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. -Remove empty string (self) from result and joins the sequence with whitespace." - (let ((mentions (remove "" - (mapcar #'mastodon-toot--process-local mentions)))) - (mapconcat #'identity mentions " "))) - -(defun mastodon-toot--process-local (acct) - "Add domain to local ACCT and replace the curent user name with \"\". -Mastodon requires the full @user@domain, even in the case of local accts. -eg. \"user\" -> \"@user@local.social\" (when local.social is the domain of the -`mastodon-instance-url'). -eg. \"yourusername\" -> \"\" -eg. \"feduser@fed.social\" -> \"@feduser@fed.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)))))) - - -;;; 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: `username@host.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))) - - -;;; 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)))) - - -;;; COMPOSE TOOT SETTINGS - -(defun mastodon-toot-set-content-warning () - "Set a content warning for the current toot." - (interactive) - (setq mastodon-toot--content-warning - (read-string "Warning: " mastodon-toot--content-warning)) - (mastodon-toot--update-status-fields)) - -(defun mastodon-toot-toggle-nsfw () - "Toggle `mastodon-toot--content-nsfw'." - (interactive) - (setq mastodon-toot--content-nsfw - (not mastodon-toot--content-nsfw)) - (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off")) - (mastodon-toot--update-status-fields)) - -(defun mastodon-toot-change-visibility (&optional arg) - "Change the current visibility to the next valid value. -With prefix ARG, read a visibility type in the minibuffer." - (interactive "P") - (if (mastodon-tl--buffer-type-eq 'edit-toot) - (user-error "You can't change visibility when editing toots") - (setq mastodon-toot--visibility - (if arg - (completing-read "Visibility: " - mastodon-toot-visibility-list) - (cond ((string= mastodon-toot--visibility "public") - "unlisted") - ((string= mastodon-toot--visibility "unlisted") - "private") - ((string= mastodon-toot--visibility "private") - "direct") - (t - "public")))) - (mastodon-toot--update-status-fields))) - -(defun mastodon-toot-set-toot-language () - "Prompt for a language and set `mastodon-toot--language'. -Return its two letter ISO 639 1 code." - (interactive) - (let* ((choice (completing-read "Language for this toot: " - mastodon-iso-639-1))) - (setq mastodon-toot--language - (alist-get choice mastodon-iso-639-1 nil nil #'string=)) - (message "Language set to %s" choice) - (mastodon-toot--update-status-fields))) - - -;;; 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"))) - - -;;; POLL - -(defun mastodon-toot--fetch-max-poll-options (instance) - "Return the maximum number of poll options from JSON data INSTANCE." - (mastodon-toot--fetch-poll-field 'max_options instance)) - -(defun mastodon-toot--fetch-max-poll-option-chars (instance) - "Return the maximum number of characters a poll option may have. -INSTANCE is JSON." - (if (alist-get 'pleroma instance) - (mastodon-toot--fetch-poll-field 'max_option_chars instance) - (or (mastodon-toot--fetch-poll-field 'max_characters_per_option instance) - 50))) ; masto default - -(defun mastodon-toot--fetch-poll-field (field instance) - "Return FIELD from the poll settings from JSON data INSTANCE." - (let* ((polls (if (alist-get 'pleroma instance) - (alist-get 'poll_limits instance) - (alist-get 'polls - (alist-get 'configuration instance))))) - (alist-get field polls))) - -(defun mastodon-toot--read-poll-options-count (max) - "Read the user's choice of the number of options the poll should have. -MAX is the maximum number set by their instance." - (let ((number (read-number (format "Number of options [2-%s]: " max) 2))) - (if (> number max) - (user-error "You need to choose a number between 2 and %s" max) - number))) - -(defun mastodon-toot-create-poll () - "Prompt for new poll options and return as a list." - (interactive) - (if mastodon-toot-poll-use-transient - (call-interactively #'mastodon-create-poll) - (mastodon-toot--read-poll))) - -(defun mastodon-toot--read-poll () - "Read poll options." - (let* ((instance (mastodon-instance-data)) - (max-options (mastodon-toot--fetch-max-poll-options instance)) - (count (mastodon-toot--read-poll-options-count max-options)) - (length (mastodon-toot--fetch-max-poll-option-chars instance)) - (multiple-p (y-or-n-p "Multiple choice? ")) - (options (mastodon-toot--read-poll-options count length)) - (hide-totals (y-or-n-p "Hide votes until poll ends? ")) - (expiry (mastodon-toot--read-poll-expiry)) - (expiry-str (cdr expiry)) - (expiry-human (car expiry))) - (setq mastodon-toot-poll - `( :options ,options :length ,length :expiry-readable ,expiry-human - :expiry ,expiry-str :multi ,multiple-p :hide ,hide-totals)) - (message "poll created!") - (mastodon-toot--update-status-fields))) - -(defun mastodon-toot--read-poll-options (count length) - "Read a list of options for poll with COUNT options. -LENGTH is the maximum character length allowed for a poll option." - (let* ((choices - (cl-loop for x from 1 to count - collect (read-string - (format "Poll option [%s/%s] [max %s chars]: " - x count length)))) - (longest (apply #'max (mapcar #'length choices)))) - (if (not (> longest length)) - choices - (user-error "Looks like you went over the max length. Try again") - (sleep-for 2) - (mastodon-toot--read-poll-options count length)))) - -(defun mastodon-toot--read-poll-expiry () - "Prompt for a poll expiry time. -Return a cons of a human readable string, and a seconds-from-now string." - ;; API requires this in seconds - (let* ((options (mastodon-toot--poll-expiry-options-alist)) - (response (completing-read "poll ends in [or enter seconds]: " - options nil 'confirm))) - (or (assoc response options #'string=) - (if (< (string-to-number response) 300) - (cons "5 minutes" (number-to-string (* 60 5))) ;; min 5 mins - (cons (format "%s seconds" response) response))))) - -(defun mastodon-toot--poll-expiry-options-alist () - "Return an alist of expiry options options in seconds." - `(("5 minutes" . ,(number-to-string (* 60 5))) - ("30 minutes" . ,(number-to-string (* 60 30))) - ("1 hour" . ,(number-to-string (* 60 60))) - ("6 hours" . ,(number-to-string (* 60 60 6))) - ("1 day" . ,(number-to-string (* 60 60 24))) - ("3 days" . ,(number-to-string (* 60 60 24 3))) - ("7 days" . ,(number-to-string (* 60 60 24 7))) - ("14 days" . ,(number-to-string (* 60 60 24 14))) - ("30 days" . ,(number-to-string (* 60 60 24 30))))) - -(defun mastodon-toot-clear-poll (&optional transient) - "Remove poll from toot compose buffer. -Sets `mastodon-toot-poll' to nil. -If TRANSIENT, we are called from a transient, so nil -`tp-transient-settings' too." - (interactive) - (let ((var (if transient - 'tp-transient-settings - 'mastodon-toot-poll))) - (if (not (symbol-value var)) - (user-error "No poll?") - (set var nil) - (when transient - (setq mastodon-toot-poll nil)) - (mastodon-toot--update-status-fields)))) - -(defun mastodon-toot--server-poll-to-local (json) - "Convert server poll data JSON to a `mastodon-toot-poll' plist." - (let-alist json - (let* ((expiry-seconds-rel - (time-to-seconds - (time-subtract - (encode-time - (parse-time-string .expires_at)) - (current-time)))) - (expiry-str (format-time-string "%s" expiry-seconds-rel)) - (expiry-human (car - (mastodon-tl--human-duration expiry-seconds-rel))) - (options (mastodon-tl--map-alist 'title .options)) - (multiple (if (eq :json-false .multiple) nil t))) - (if mastodon-toot-poll-use-transient - (setq mastodon-toot-poll - `((multi . ,multiple) - (expiry . ,expiry-str) - ;; (hide . ,hide) - (one . ,(nth 0 options)) - (two . ,(nth 1 options)) - (three . ,(nth 2 options)) - (four . ,(nth 3 options)))) - (setq mastodon-toot-poll - `( :options ,options :expiry-readable ,expiry-human - :expiry ,expiry-str :multi ,multiple)))))) - - -;;; 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)))) - - -;;; DISPLAY KEYBINDINGS - -(defun mastodon-toot--get-kbinds () - "Get a list of the keybindings in the `mastodon-toot-mode'." - (let* ((binds (copy-tree mastodon-toot-mode-map)) - (prefix (car (cadr binds))) - (bindings (remove nil - (mapcar (lambda (i) - (when (listp i) i)) - (cadr binds))))) - (mapcar (lambda (b) - (setf (car b) (vector prefix (car b))) - b) - bindings))) - -(defun mastodon-toot--format-kbind-command (cmd) - "Format CMD to be more readable. -e.g. `mastodon-toot-send' -> Send." - (let* ((str (symbol-name cmd)) - (re "mastodon-toot-\\(.*\\)$") - (str2 (save-match-data - (string-match re str) - (match-string 1 str)))) - (capitalize (replace-regexp-in-string "-" " " str2)))) - -(defun mastodon-toot--format-kbind (kbind) - "Format a single keybinding, KBIND, for display in documentation." - (let ((key (concat "\\`" - (help-key-description (car kbind) nil) - "'")) - (command (mastodon-toot--format-kbind-command (cdr kbind)))) - (substitute-command-keys - (format - (concat (mastodon-toot--comment " ") - "%-10s" - (mastodon-toot--comment " - %s")) - key command)))) - -(defun mastodon-toot--comment (str) - "Propertize STR with `mastodon-toot-docs-face'." - (propertize str - 'face 'mastodon-toot-docs-face)) - -(defun mastodon-toot--format-kbinds (kbinds) - "Format a list of keybindings, KBINDS, for display in documentation." - (mapcar #'mastodon-toot--format-kbind kbinds)) - -(defvar-local mastodon-toot--kbinds-pairs nil - "Contains a list of paired toot compose buffer keybindings for inserting.") - -(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest) - "Return a list of strings each containing two formatted kbinds. -KBINDS-LIST is the list of formatted bindings to pair. -LONGEST is the length of the longest binding." - (when kbinds-list - (push (concat "\n" - (car kbinds-list) - (make-string (- (1+ longest) (length (car kbinds-list))) - ?\ ) - (cadr kbinds-list)) - mastodon-toot--kbinds-pairs) - (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest)) - (reverse mastodon-toot--kbinds-pairs)) - -(defun mastodon-toot--kbinds-longest (kbinds-list) - "Return the length of the longest item in KBINDS-LIST." - (let ((lengths (mapcar #'length kbinds-list))) - (car (sort lengths #'>)))) - - -;;; DISPLAY DOCS - -(defun mastodon-toot--make-mode-docs () - "Create formatted documentation text for `mastodon-toot-mode'." - (let* ((kbinds (mastodon-toot--get-kbinds)) - (formatted (mastodon-toot--format-kbinds kbinds)) - (longest-kbind (mastodon-toot--kbinds-longest - formatted))) - (concat - (mastodon-toot--comment - " Compose a new toot here. The following keybindings are available:") - (mapconcat - #'identity - (mastodon-toot--formatted-kbinds-pairs formatted longest-kbind) - nil)))) - -(defun mastodon-toot--format-reply-in-compose (reply-text) - "Format a REPLY-TEXT for display in compose buffer docs." - (let* ((rendered (mastodon-tl--render-text reply-text)) - (no-props (substring-no-properties rendered)) - ;; FIXME: this replaces \n at end of every post, so we have to trim: - (no-newlines (string-trim - (replace-regexp-in-string "[\n]+" " " no-props))) - (reply-to (concat " Reply to: \"" no-newlines "\"")) - (crop (truncate-string-to-width reply-to - mastodon-toot-orig-in-reply-length))) - (if (> (length no-newlines) - (length crop)) ; we cropped: - (concat crop "\n") - (concat reply-to "\n")))) - -(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text) - "Insert propertized text with documentation about `mastodon-toot-mode'. -Also includes and the status fields which will get updated based -on the status of NSFW, content warning flags, media attachments, etc. -REPLY-TEXT is the text of the toot being replied to." - (let ((divider - "|=================================================================|")) - (insert - (concat - (mastodon-toot--make-mode-docs) "\n" - (mastodon-toot--comment divider) "\n" - (propertize - (concat - " " - (propertize "Count" - 'toot-post-counter t) - " ⋅ " - (propertize "Visibility" - 'toot-post-visibility t) - " ⋅ " - (propertize "Language" - 'toot-post-language t) - " " - (propertize "Scheduled" - 'toot-post-scheduled t) - " " - (propertize "CW" - 'toot-post-cw-flag t) - " " - (propertize "POLL" - 'toot-post-poll-flag t) - " " - (propertize "NSFW" - 'toot-post-nsfw-flag t) - "\n" - " Attachments: " - (propertize "None " - 'toot-attachments t) - "\n" - (when reply-text - (propertize - (mastodon-toot--format-reply-in-compose reply-text) - 'toot-reply t)) - divider) - 'face 'mastodon-toot-docs-face - 'read-only "Edit your message below." - 'toot-post-header t)) - ;; allow us to enter text after read-only header: - (propertize "\n\n" - 'rear-nonsticky t)))) - -(defun mastodon-toot--most-restrictive-visibility (reply-visibility) - "Return REPLY-VISIBILITY or default visibility, whichever is more restrictive. -The default is given by `mastodon-toot--default-reply-visibility'." - (unless (null reply-visibility) - (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility) - mastodon-toot-visibility-list))) - (if (member (intern reply-visibility) less-restrictive) - reply-visibility - mastodon-toot--default-reply-visibility)))) - -(defun mastodon-toot--render-reply-region-str (str) - "Refill STR and prefix all lines with >, as reply-quote text." - (with-temp-buffer - (insert str) - ;; unfill first: - (let ((fill-column (point-max))) - (fill-region (point-min) (point-max))) - ;; then fill: - (fill-region (point-min) (point-max)) - ;; add our own prefix, pauschal: - (goto-char (point-min)) - (save-match-data - (while (re-search-forward "^" nil t) - (replace-match " > "))) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id - reply-json reply-region) - "If REPLY-TO-USER is provided, inject their handle into the message. -If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'. -REPLY-JSON is the full JSON of the toot being replied to. -REPLY-REGION is a string to be injected into the buffer." - (let ((reply-visibility (mastodon-toot--most-restrictive-visibility - (alist-get 'visibility reply-json))) - (reply-cw (alist-get 'spoiler_text reply-json))) - (when reply-to-user - (when (> (length reply-to-user) 0) ; self is "" unforch - (insert (format "%s " reply-to-user))) - (when reply-region - (insert "\n" - (mastodon-toot--render-reply-region-str reply-region) - "\n")) - (setq mastodon-toot--reply-to-id reply-to-id) - (unless (string= mastodon-toot--visibility reply-visibility) - (setq mastodon-toot--visibility reply-visibility)) - (mastodon-toot--set-cw reply-cw)))) - -(defun mastodon-toot--update-status-fields (&rest _args) - "Update the status fields in the header based on the current state." - (ignore-errors ;; called from after-change-functions so let's not leak errors - (let* ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'toot-post-header - (point-min))) - (count-region (mastodon-tl--find-property-range 'toot-post-counter - (point-min))) - (vis-region (mastodon-tl--find-property-range - 'toot-post-visibility (point-min))) - (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag - (point-min))) - (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag - (point-min))) - (lang-region (mastodon-tl--find-property-range 'toot-post-language - (point-min))) - (sched-region (mastodon-tl--find-property-range 'toot-post-scheduled - (point-min))) - (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag - (point-min))) - (toot-string (buffer-substring-no-properties (cdr header-region) - (point-max)))) - (mastodon-toot--apply-fields-props - count-region - (format "%s/%s chars" - (mastodon-toot--count-toot-chars toot-string) - (number-to-string mastodon-toot--max-toot-chars))) - (mastodon-toot--apply-fields-props - vis-region - (format "%s" - (if (string= "private" mastodon-toot--visibility) - "followers-only" - mastodon-toot--visibility))) - ;; WHEN clauses don't work here, we need "" as display arg: - (mastodon-toot--apply-fields-props - lang-region - (if mastodon-toot--language - (format "Lang: %s ⋅" mastodon-toot--language) - "")) - (mastodon-toot--apply-fields-props - sched-region - (if mastodon-toot--scheduled-for - (format "Scheduled: %s ⋅" - (mastodon-toot--iso-to-human - mastodon-toot--scheduled-for)) - "")) - (mastodon-toot--apply-fields-props - nsfw-region - (if mastodon-toot--content-nsfw - (if mastodon-toot--media-attachments - "NSFW" "NSFW (attachments only)") - "") - 'mastodon-cw-face) - (mastodon-toot--apply-fields-props - poll-region - (if mastodon-toot-poll - "POLL" - "") - 'mastodon-cw-face - (prin1-to-string mastodon-toot-poll)) - (mastodon-toot--apply-fields-props - cw-region - (if (and mastodon-toot--content-warning - (not (string= "" mastodon-toot--content-warning))) - (format "CW: %s" mastodon-toot--content-warning) - " ") ;; hold the blank space - 'mastodon-cw-face)))) - -(defun mastodon-toot--apply-fields-props (region display &optional face help-echo) - "Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end." - (add-text-properties (car region) (cdr region) - `(display - ,display - ,@(when face `(face ,face)) - ,@(when help-echo `(help-echo ,help-echo))))) - -(defun mastodon-toot--count-toot-chars (toot-string &optional cw) - "Count the characters in TOOT-STRING. -URLs always = 23, and domain names of handles are not counted. -This is how mastodon does it. -CW is the content warning, which contributes to the character count." - ;; FIXME: URL chars is avail at /api/v1/instance - ;; for masto, it's .statuses.characters_reserved_per_url - (let* ((url-replacement (make-string 23 ?x)) - (count-str - (replace-regexp-in-string ; handle @handles - mastodon-toot-handle-regex "\\4" - (replace-regexp-in-string ; handle URLs - mastodon-toot-url-regex url-replacement toot-string)))) - (+ (length cw) - (length count-str)))) - - -;;; 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!")) - - -;;; 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))))))) - - -;;; 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 diff --git a/elpa/mastodon-20251201.1553/mastodon-transient.el b/elpa/mastodon-20251201.1553/mastodon-transient.el deleted file mode 100644 index 3c8b369e..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-transient.el +++ /dev/null @@ -1,496 +0,0 @@ -;;; mastodon-transient.el --- transient menus for mastodon.el -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 martian hiatus - -;; Author: martian hiatus -;; 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 . - -;;; Commentary: - -;; - -;;; Code: - -(require 'transient) -(require 'tp) - -(defvar mastodon-active-user) -(defvar mastodon-toot-visibility-settings-list) -(defvar mastodon-iso-639-regional) -(defvar mastodon-toot-poll) - -(autoload 'mastodon-toot-visibility-settings-list "mastodon-toot") -(autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-http--api "mastodon-http") -(autoload 'mastodon-http--triage "mastodon-http") -(autoload 'mastodon-http--patch "mastodon-http") -(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile") -(autoload 'mastodon-toot--fetch-max-poll-options "mastodon-toot") -(autoload 'mastodon-toot--fetch-max-poll-option-chars "mastodon-toot") -(autoload 'mastodon-instance-data "mastodon") -(autoload 'mastodon-toot--update-status-fields "mastodon-toot") -(autoload 'mastodon-toot--read-poll-expiry "mastodon-toot") -(autoload 'mastodon-toot--poll-expiry-options-alist "mastodon-toot") -(autoload 'mastodon-toot-clear-poll "mastodon-toot") -(autoload 'mastodon-notifications-get-policy "mastodon-notifications") - -;;; UTILS - -(transient-define-suffix mastodon-transient--prefix-inspect () - "Inspect a transient prefix's arguments and scope." - (interactive) - :transient 'transient--do-return - (let ((args (transient-args (oref transient-current-prefix command))) - (scope (oref transient-current-prefix scope))) - (message "prefix's scope: %s \ntransient-args: %s\n last: %s" - scope args - (length - (cl-member-if - (lambda (x) - (equal (car x) 'one)) - args))))) - -;; some JSON fields that are returned under the "source" field need to be -;; sent back in the format source[key], while some others are sent kust as -;; key: -(defun mastodon-transient-parse-source-key (key) - "Parse mastodon source KEY. -If KEY needs to be source[key], format like so, else just return -the inner key part." - (let* ((split (split-string key "[][]")) - (array-key (cadr split))) - (if (or (= 1 (length split)) ;; no split - (member array-key '("privacy" "sensitive" "language"))) - key - array-key))) - -(defun mastodon-transient-parse-source-keys (alist) - "Parse ALIST containing source[key] keys." - (cl-loop for a in alist - collect (cons (mastodon-transient-parse-source-key (car a)) - (cdr a)))) - -(defun mastodon-transient-get-creds () - "Fetch account data." - (mastodon-http--get-json - (mastodon-http--api "accounts/verify_credentials") - nil :silent)) - -;; fields utils: -;; to PATCH fields, we just need fields[x][name] and fields[x][value] - -(defun mastodon-transient--fields-alist (fields) - "Convert fields in FIELDS to numbered conses. -The keys in the data are not numbered, so we convert the key into -the format fields.X.keyname." - (cl-loop - for f in fields - for count from 1 to 5 - collect - (cl-loop for x in f - collect - (cons (concat "fields." (number-to-string count) - "." (symbol-name (car x))) - (cdr x))))) - -(defun mastodon-transient-field-dot-to-array (key) - "Convert KEY from tp dot annotation to array[key] annotation." - (tp-dot-to-array (symbol-name key) nil "_attributes")) - -(defun mastodon-transient-dot-fields-to-arrays (alist) - "Parse fields ALIST in dot notation to array notation." - (cl-loop for y in alist - collect - (cons (mastodon-transient-field-dot-to-array (car y)) - (cdr y)))) - -;;; TRANSIENTS - -;; FIXME: PATCHing source vals as JSON request body doesn't work! existing -;; `mastodon-profile--update-preference' doesn't use it! it just uses -;; query params! strange thing is it works for non-source params -(transient-define-suffix mastodon-user-settings-update (&optional args) - "Update current user settings on the server." - :transient 'transient--do-exit - (interactive (list (transient-args 'mastodon-user-settings))) - (let* ((parsed (tp-parse-args-for-send args :strings)) - (strs (mastodon-transient-parse-source-keys parsed)) - (url (mastodon-http--api "accounts/update_credentials")) - (resp (mastodon-http--patch url strs))) ;; :json fails - (mastodon-http--triage - resp - (lambda (_resp) - (message "Settings updated!\n%s" (pp-to-string strs)))))) - -(transient-define-prefix mastodon-user-settings () - "A transient for setting current user settings." - :value (lambda () (tp-return-data - #'mastodon-transient-get-creds)) - [:description - (lambda () - (format "User settings for %s" mastodon-active-user)) - (:info - "Note: use the empty string (\"\") to remove a value from an option.")] - ;; strings - ["Account info" - ("n" "display name" "display_name" :alist-key display_name :class tp-option-str) - ("t" "update profile note" mastodon-update-profile-note) - ("f" "update profile fields" mastodon-profile-fields)] - ;; "choice" booleans (so we can PATCH :json-false explicitly): - ["Account options" - ("l" "locked" "locked" :alist-key locked :class tp-bool) - ("b" "bot" "bot" :alist-key bot :class tp-bool) - ("d" "discoverable" "discoverable" :alist-key discoverable :class tp-bool) - ("c" "hide follower/following lists" "source.hide_collections" - :alist-key source.hide_collections :class tp-bool) - ("i" "indexable" "source.indexable" :alist-key source.indexable :class tp-bool)] - ["Tooting options" - ("p" "default privacy" "source.privacy" :alist-key source.privacy - :class tp-option - :choices (lambda () mastodon-toot-visibility-settings-list)) - ("s" "mark sensitive" "source.sensitive" :alist-key source.sensitive :class tp-bool) - ("g" "default language" "source.language" :alist-key source.language :class tp-option - :choices (lambda () mastodon-iso-639-regional))] - ["Update" - ("C-c C-c" "Save settings" mastodon-user-settings-update) - ("C-x C-k" :info "Revert all changes")] - (interactive) - (if (or (not (boundp 'mastodon-active-user)) - (not mastodon-active-user)) - (user-error "User not set") - (transient-setup 'mastodon-user-settings))) - -(transient-define-suffix mastodon-update-profile-note () - "Update current user profile note." - :transient 'transient--do-exit - (interactive) - (mastodon-profile-update-user-profile-note)) - -(transient-define-suffix mastodon-profile-fields-update (args) - "Update current user profile fields." - :transient 'transient--do-return - (interactive (list (transient-args 'mastodon-profile-fields))) - (let* (;; FIXME: maybe only changed also won't work with fields, as - ;; perhaps what is PATCHed overwrites whatever is on the server? - ;; (only-changed (tp-only-changed-args alist)) - (arrays (mastodon-transient-dot-fields-to-arrays args)) - (endpoint "accounts/update_credentials") - (url (mastodon-http--api endpoint)) - (resp (mastodon-http--patch url arrays))) ; :json))) - (mastodon-http--triage - resp (lambda (_resp) (message "Fields updated!"))))) - -(defun mastodon-transient-fetch-fields () - "Fetch profile fields (metadata)." - (tp-return-data #'mastodon-transient-get-creds nil 'fields) - (setq tp-transient-settings - (mastodon-transient--fields-alist tp-transient-settings))) - -(transient-define-prefix mastodon-profile-fields () - "A transient for setting profile fields." - :value (lambda () (mastodon-transient-fetch-fields)) - [:description - "Fields" - ["Name" - ("1 n" "" "fields.1.name" :alist-key fields.1.name :class mastodon-transient-field) - ("2 n" "" "fields.2.name" :alist-key fields.2.name :class mastodon-transient-field) - ("3 n" "" "fields.3.name" :alist-key fields.3.name :class mastodon-transient-field) - ("4 n" "" "fields.4.name" :alist-key fields.4.name :class mastodon-transient-field)] - ["Value" - ("1 v" "" "fields.1.value" :alist-key fields.1.value :class mastodon-transient-field) - ("2 v" "" "fields.2.value" :alist-key fields.2.value :class mastodon-transient-field) - ("3 v" "" "fields.3.value" :alist-key fields.3.value :class mastodon-transient-field) - ("4 v" "" "fields.4.value" :alist-key fields.4.value :class mastodon-transient-field)]] - ["Update" - ("C-c C-c" "Save settings" mastodon-profile-fields-update) - ("C-x C-k" :info "Revert all changes")] - (interactive) - (if (not mastodon-active-user) - (user-error "User not set") - (transient-setup 'mastodon-profile-fields))) - -(defun mastodon-transient-max-poll-opts () - "Return max poll options of user's instance." - (let ((instance (mastodon-instance-data))) - (mastodon-toot--fetch-max-poll-options instance))) - -(defun mastodon-transient-max-poll-opt-chars () - "Return max poll option characters of user's instance." - (let ((instance (mastodon-instance-data))) - (mastodon-toot--fetch-max-poll-option-chars instance))) - -(transient-define-suffix mastodon-transient-choice-add () - "Add another poll choice if possible. -Do not add more than 9 choices. -Do not add more than the server's maximum setting." - (interactive) - :transient 'transient--do-stay - (let* ((args (transient-args (oref transient-current-prefix command))) - (choice-count (length - (cl-member-if - (lambda (x) - (equal (car x) 'one)) - args))) - (inc (1+ choice-count)) - (next (number-to-string inc)) - (next-symbol (pcase inc - (5 'five) - (6 'six) - (7 'seven) - (8 'eight) - (9 'nine)))) - (if (or (>= choice-count (mastodon-transient-max-poll-opts)) - (= choice-count 9)) - ;; FIXME when we hit '10', we get a binding clash with '1'. :/ - (message "Max choices reached") - (transient-append-suffix - 'mastodon-create-poll - '(2 -1) - `(,next "" ,next - :class mastodon-transient-poll-choice - :alist-key ,next-symbol - :transient t)))) - (transient-setup 'mastodon-create-poll)) - -(transient-define-prefix mastodon-create-poll () - "A transient for creating a poll." - :value (lambda () - ;; we set `tp-transient-settings' here to the poll value poss - ;; pulled from the server by - ;; `mastodon-toot--server-poll-to-local'. when we are done with - ;; the transient, we set `mastodon-toot-poll' again - (setq tp-transient-settings mastodon-toot-poll)) - ["Create poll" - (:info (lambda () - (format "Max options: %s" - (mastodon-transient-max-poll-opts)))) - (:info (lambda () - (format "Max option length: %s" - (mastodon-transient-max-poll-opt-chars))))] - ["Options" - ("m" "Multiple choice?" "multi" :alist-key multi - :class mastodon-transient-poll-bool) - ("h" "Hide vote count till expiry?" "hide" :alist-key hide - :class mastodon-transient-poll-bool) - ("e" "Expiry" "expiry" :alist-key expiry - :class mastodon-transient-expiry)] - ["Choices" - ("1" "" "1" :alist-key one :class mastodon-transient-poll-choice) - ("2" "" "2" :alist-key two :class mastodon-transient-poll-choice) - ("3" "" "3" :alist-key three :class mastodon-transient-poll-choice) - ("4" "" "4" :alist-key four :class mastodon-transient-poll-choice)] - ;; TODO: display the max number of options or add options cmd - ["Update" - ("C-c C-s" "Add another poll choice" mastodon-transient-choice-add - :if (lambda () (< 4 (mastodon-transient-max-poll-opts)))) - ("C-c C-c" "Save and done" mastodon-create-poll-done) - ("C-x C-k" :info "Revert all") - ("C-c C-k" "Delete all" mastodon-clear-poll)] - (interactive) - (if (not mastodon-active-user) - (user-error "User not set") - (transient-setup 'mastodon-create-poll))) - -(transient-define-suffix mastodon-clear-poll () - "Clear current poll data." - :transient 'transient--do-stay - (interactive) - (mastodon-toot-clear-poll :transient) - (transient-reset)) - -(transient-define-suffix mastodon-create-poll-done (args) - "Finish setting poll details." - :transient 'transient--do-exit - (interactive (list (transient-args 'mastodon-create-poll))) - (let* ((options (cl-member-if (lambda (x) - (eq (car x) 'one)) - args)) - (opt-vals (cl-loop for x in options - collect (cdr x))) - (lengths (mapcar #'length opt-vals)) - (vals (cl-remove 'nil - (cl-loop for x in args - collect (cdr x)))) - (opts-count (length (cl-remove 'nil opt-vals)))) - ;; this way of checking gets annoying if we want to just cancel out of - ;; the poll (but to actually cancel user should C-g, not C-c C-c): - (if (or (and (< 50 (apply #'max lengths)) - (not (y-or-n-p "Options longer than server max. Proceed? "))) - (and (not (alist-get 'expiry args)) - (not (y-or-n-p "No expiry. Proceed? "))) - (and (not (< 1 opts-count)) - (not (y-or-n-p "Need more than one option. Proceed? "))) - (and (> opts-count (mastodon-transient-max-poll-opts)) - (not (y-or-n-p "More options than server max. Proceed? ")))) - (call-interactively #'mastodon-create-poll) - ;; if we are called with no poll data, do not set: - (unless (not vals) - ;; we set `mastodon-toot-poll' here not `tp-transient-settings' - ;; as that is our var outside of our transient: - (setq mastodon-toot-poll - (tp-bools-to-strs args))) - (mastodon-toot--update-status-fields)))) - -(defvar mastodon-notifications-policy-vals) -(declare-function mastodon-notifications-get-policy "mastodon-notifications") -(declare-function mastodon-notifications--update-policy "mastodon-notifications") - -(transient-define-prefix mastodon-notifications-policy () - "A transient to set notifications policy options." - ;; https://docs.joinmastodon.org/methods/notifications/#get-policy - :value (lambda () (tp-return-data #'mastodon-notifications-get-policy)) - ["Notification policy options" - ("f" "people you don't follow" "for_not_following" - :alist-key for_not_following :class mastodon-transient-policy) - ("F" "people not following you" "for_not_followers" - :alist-key for_not_followers :class mastodon-transient-policy) - ("n" "New accounts" "for_new_accounts" - :alist-key for_new_accounts :class mastodon-transient-policy) - ("p" "Unsolicited private mentions" "for_private_mentions" - :alist-key for_private_mentions :class mastodon-transient-policy) - ("l" "Moderated accounts" "for_limited_accounts" - :alist-key for_limited_accounts :class mastodon-transient-policy) - (:info "") - (:info "\"accept\" = receive notifications") - (:info "\"filter\" = mark as filtered") - (:info "\"drop\" = do not receive any notifications")] - ["Notification requests" - (:info #'mastodon-notifications-requests-count) - (:info #'mastodon-notifications-filtered-count)] - ["Update" - ("C-c C-c" "Save settings" mastodon-notifications-policy-update) - ("C-x C-k" :info "Revert all changes")]) - -(defun mastodon-notifications-requests-count () - "Format a string for pending requests." - (let ((val (oref transient--prefix value))) - (format "Pending requests: %d" - (or (map-nested-elt - val - '(summary pending_requests_count)) - 0)))) - -(defun mastodon-notifications-filtered-count () - "Format a string for pending notifications." - (let ((val (oref transient--prefix value))) - (format "Pending notifications: %d" - (or (map-nested-elt - val - '(summary pending_notifications_count)) - 0)))) - -(transient-define-suffix mastodon-notifications-policy-update (args) - "Send updated notification policy settings." - :transient 'transient--do-exit - ;; TODO: - (interactive (list (transient-args 'mastodon-notifications-policy))) - (let* ((parsed (tp-parse-args-for-send args)) - (resp (mastodon-notifications--update-policy parsed))) - (mastodon-http--triage - resp - (lambda (_resp) - (message "Settings updated!\n%s" (pp-to-string parsed)))))) - -;;; CLASSES - -(defclass mastodon-transient-policy (tp-cycle) - ((choices :initarg :choices :initform 'mastodon-notifications-policy-vals)) - "An option class for mastodon notification policy options.") - -(defclass mastodon-transient-field (tp-option-str) - ((always-read :initarg :always-read :initform t)) - "An infix option class for our options. -We always read.") - -(cl-defmethod transient-init-value ((obj mastodon-transient-field)) - "Initialize value of OBJ." - (let* ((prefix-val (oref transient--prefix value))) - ;; (arg (oref obj alist-key))) - (oset obj value - (tp-get-server-val obj prefix-val)))) - -(cl-defmethod tp-get-server-val ((obj mastodon-transient-field) data) - "Return the server value for OBJ from DATA. -If OBJ's key has dotted notation, drill down into the alist. Currently -only one level of nesting is supported." - ;; TODO: handle nested alist keys - (let* ((key (oref obj alist-key)) - (split (split-string (symbol-name key) "\\.")) - (num (string-to-number (cadr split)))) - (alist-get key - (nth (1- num) data) nil nil #'string=))) - -(cl-defmethod tp-arg-changed-p ((_obj mastodon-transient-field) cons) - "T if value of OBJ is changed from the server value. -CONS is a cons of the form \"(fields.1.name . val)\"." - (let* ((key-split (split-string - (symbol-name (car cons)) "\\.")) - (num (1- (string-to-number (nth 1 key-split)))) - (server-key (symbol-name (car cons))) - (server-elt (nth num tp-transient-settings))) - (not (equal (cdr cons) - (alist-get server-key server-elt nil nil #'string=))))) - -(defclass mastodon-transient-opt (tp-option tp-option-var) - (())) - -(defclass mastodon-transient-poll-bool (tp-bool tp-option-var) - ()) - -(defclass mastodon-transient-poll-choice (tp-option-str tp-option-var) - ()) - -(cl-defmethod transient-infix-read ((obj mastodon-transient-poll-choice)) - "Reader function for OBJ, a poll expiry." - (let* ((value (transient-infix-value obj)) - (prompt (transient-prompt obj)) - (str (read-string prompt (cdr value))) - (max (mastodon-transient-max-poll-opt-chars))) - (if (not (> (length str) max)) - str - (if (not - (y-or-n-p - (format "Poll option too long for server (%s/%s chars), retry?" - (length str) max))) - str - (oset obj value str) - (transient-infix-read obj))))) - -(defclass mastodon-transient-expiry (tp-option tp-option-var) - ()) - -(cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry)) - "Reader function for OBJ, a poll expiry." - (cdr (mastodon-toot--read-poll-expiry))) - -(cl-defmethod transient-format-value ((obj mastodon-transient-expiry)) - "Format function for OBJ, a poll expiry." - (let* ((cons (transient-infix-value obj)) - (value (when cons (cdr cons)))) - (if (not value) - "" - (let ((readable - (or (car - (rassoc value - (mastodon-toot--poll-expiry-options-alist))) - (concat value " secs")))) ;; editing a poll wont match expiry list - (propertize readable - 'face (if (tp-arg-changed-p obj cons) - 'transient-value - 'transient-inactive-value)))))) - -(provide 'mastodon-transient) -;;; mastodon-transient.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-views.el b/elpa/mastodon-20251201.1553/mastodon-views.el deleted file mode 100644 index ab4ccaac..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-views.el +++ /dev/null @@ -1,1070 +0,0 @@ -;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*- - -;; Copyright (C) 2020-2024 Marty Hiatt -;; Author: Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; 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") - - -;;; 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.") - - -;;; GENERAL FUNCTION - -(defun mastodon-views--minor-view (view-name insert-fun data) - "Load a minor view named VIEW-NAME. -BINDINGS-STRING is a string explaining the view's local bindings. -INSERT-FUN is the function to call to insert the view's elements. -DATA is the argument to insert-fun, usually JSON returned in a -request. -This function is used as the update-function to -`mastodon-tl--init-sync', which initializes a buffer for us and -provides the JSON data." - ;; FIXME not tecnically an update-fun for init-sync, but just a simple way - ;; to set up the empty buffer or else call the insert-fun. not sure if we cd - ;; improve by eg calling init-sync in here, making this a real view function. - (if (seq-empty-p data) - (insert (propertize - (format "Looks like you have no %s for now." view-name) - 'face 'mastodon-toot-docs-face - 'byline t - 'item-type 'no-item ; for nav - 'item-id "0")) ; so point can move here when no item - (funcall insert-fun data) - (goto-char (point-min))) - ;; (when data - ;; FIXME: this seems to trigger a new request, but ideally would run. - ;; (mastodon-tl-goto-next-item)) - ) - - -;;; LISTS - -(defun mastodon-views-view-lists () - "Show the user's lists in a new buffer." - (interactive) - (mastodon-tl--init-sync "lists" "lists" - 'mastodon-views--insert-lists - nil nil nil - "your lists" - "C - create a list\n D - delete a list\ - \n A/R - add/remove account from a list\ - \n E - edit a list\n n/p - go to next/prev item") - (with-current-buffer "*mastodon-lists*" - (use-local-map mastodon-views--view-lists-keymap))) - -(defun mastodon-views--insert-lists (json) - "Insert the user's lists from JSON." - (mastodon-views--minor-view - "lists" - #'mastodon-views--print-list-set - json)) - -(defun mastodon-views--print-list-set (lists) - "Print each account plus a separator for each list in LISTS." - (cl-loop for x in lists - do (progn - (mastodon-views--print-list-accounts x) - (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n") - 'face 'success))))) - -(defun mastodon-views--print-list-accounts (list) - "Insert the accounts in list named LIST, an alist." - (let-alist list - (let* ((accounts (mastodon-views--accounts-in-list .id))) - (insert - (propertize .title - 'byline t ; so we nav here - 'item-id "0" ; so we nav here - 'item-type 'list - 'help-echo "RET: view list timeline, d: delete this list, \ -a: add account to this list, r: remove account from this list" - 'list t - 'face 'link - 'keymap mastodon-views--list-name-keymap - 'list-name .title - 'list-id .id) - (propertize (format " [replies: %s, exclusive %s]" - .replies_policy - (when (eq t .exclusive) "true")) - 'face 'mastodon-toot-docs-face) - (propertize "\n\n" - 'list t - 'keymap mastodon-views--list-name-keymap - 'list-name .title - 'list-id .id) - (propertize - (mapconcat #'mastodon-search--propertize-user accounts - " ") - 'list t - 'keymap mastodon-views--list-name-keymap - 'list-name .title - 'list-id .id))))) - -(defun mastodon-views--get-users-lists () - "Get the list of the user's lists from the server." - (let ((url (mastodon-http--api "lists"))) - (mastodon-http--get-json url))) - -(defun mastodon-views--get-lists-names () - "Return a list of the user's lists' names." - (let ((lists (mastodon-views--get-users-lists))) - (mastodon-tl--map-alist 'title lists))) - -(defun mastodon-views--get-list-by-name (name) - "Return the list data for list with NAME." - (let* ((lists (mastodon-views--get-users-lists))) - (cl-loop for list in lists - if (string= (alist-get 'title list) name) - return list))) - -(defun mastodon-views--get-list-id (name) - "Return id for list with NAME." - (let ((list (mastodon-views--get-list-by-name name))) - (alist-get 'id list))) - -(defun mastodon-views--get-list-name (id) - "Return name of list with ID." - (let* ((url (mastodon-http--api (format "lists/%s" id))) - (response (mastodon-http--get-json url))) - (alist-get 'title response))) - -(defun mastodon-views-edit-list-at-point () - "Edit list at point." - (interactive) - (let ((id (mastodon-tl--property 'list-id :no-move))) - (mastodon-views-edit-list id))) - -(defun mastodon-views-edit-list (&optional id) - "Prompt for a list and edit the name and replies policy. -If ID is provided, use that list." - (interactive) - (let* ((list-names (unless id (mastodon-views--get-lists-names))) - (name-old (if id - (mastodon-tl--property 'list-name :no-move) - (completing-read "Edit list: " list-names))) - (id (or id (mastodon-views--get-list-id name-old))) - (name-choice (read-string "List name: " name-old)) - (replies-policy (completing-read "Replies policy: " ; give this a proper name - '("followed" "list" "none") - nil t nil nil "list")) - (exclusive (if (y-or-n-p "Exclude items from home timeline? ") - "true" - "false")) - (url (mastodon-http--api (format "lists/%s" id))) - (response (mastodon-http--put url - `(("title" . ,name-choice) - ("replies_policy" . ,replies-policy) - ("exclusive" . ,exclusive))))) - (mastodon-http--triage response - (lambda (_) - (with-current-buffer response - (let* ((json (mastodon-http--process-json)) - (name-new (alist-get 'title json))) - (message "list %s edited to %s!" name-old name-new))) - (when (mastodon-tl--buffer-type-eq 'lists) - (mastodon-views-view-lists)))))) - -(defun mastodon-views-view-timeline-list-at-point () - "View timeline of list at point." - (interactive) - (let ((list-id (mastodon-tl--property 'list-id :no-move))) - (mastodon-views-view-list-timeline list-id))) - -(defun mastodon-views-view-list-timeline (&optional id) - "Prompt for a list and view its timeline. -If ID is provided, use that list." - (interactive) - (let* ((list-names (unless id (mastodon-views--get-lists-names))) - (list-name (unless id (completing-read "View list: " list-names))) - (id (or id (mastodon-views--get-list-id list-name))) - (endpoint (format "timelines/list/%s" id)) - (name (mastodon-views--get-list-name id)) - (buffer-name (format "list-%s" name))) - (mastodon-tl--init buffer-name endpoint - 'mastodon-tl--timeline nil - `(("limit" . ,mastodon-tl--timeline-posts-count))))) - -(defun mastodon-views-create-list () - "Create a new list. -Prompt for name and replies policy." - (interactive) - (let* ((title (read-string "New list name: ")) - (replies-policy - (completing-read "Replies policy: " ; give this a proper name - '("followed" "list" "none") - nil t nil nil "list")) ; default - (exclusive (when (y-or-n-p "Exclude items from home timeline? ") - "true")) - (response (mastodon-http--post - (mastodon-http--api "lists") - `(("title" . ,title) - ("replies_policy" . ,replies-policy) - ("exclusive" . ,exclusive))))) - (mastodon-views--list-action-triage - response "list %s created!" title))) - -(defun mastodon-views-delete-list-at-point () - "Delete list at point." - (interactive) - (let ((id (mastodon-tl--property 'list-id :no-move))) - (mastodon-views-delete-list id))) - -(defun mastodon-views-delete-list (&optional id) - "Prompt for a list and delete it. -If ID is provided, delete that list." - (interactive) - (let* ((list-names (unless id (mastodon-views--get-lists-names))) - (name (if id - (mastodon-views--get-list-name id) - (completing-read "Delete list: " list-names))) - (id (or id (mastodon-views--get-list-id name))) - (url (mastodon-http--api (format "lists/%s" id)))) - (when (y-or-n-p (format "Delete list %s?" name)) - (let ((response (mastodon-http--delete url))) - (mastodon-views--list-action-triage - response "list %s deleted!" name))))) - -(defun mastodon-views--get-users-followings () - "Return the list of followers of the logged in account." - (let* ((id (mastodon-auth--get-account-id)) - (url (mastodon-http--api (format "accounts/%s/following" id)))) - (mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts - -(defun mastodon-views-add-account-to-list-at-point () - "Prompt for account and add to list at point." - (interactive) - (let ((id (mastodon-tl--property 'list-id :no-move))) - (mastodon-views-add-account-to-list id))) - -(defun mastodon-views-add-account-to-list (&optional id account-id handle) - "Prompt for a list and for an account, add account to list. -If ID is provided, use that list. -If ACCOUNT-ID and HANDLE are provided use them rather than prompting." - (interactive) - (let* ((list-prompt (if handle - (format "Add %s to list: " handle) - "Add account to list: ")) - (list-name (if id - (mastodon-tl--property 'list-name :no-move) - (completing-read list-prompt - (mastodon-views--get-lists-names) nil t))) - (list-id (or id (mastodon-views--get-list-id list-name))) - (followings (unless handle - (mastodon-views--get-users-followings))) - (handles (unless handle - (mastodon-tl--map-alist-vals-to-alist - 'acct 'id followings))) - (account (or handle (completing-read "Account to add: " - handles nil t))) - (account-id (or account-id (alist-get account handles))) - (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) - (mastodon-views--list-action-triage - response "%s added to list %s!" account list-name))) - -(defun mastodon-views-add-toot-account-at-point-to-list () - "Prompt for a list, and add the account of the toot at point to it." - (interactive) - (let* ((toot (mastodon-tl--property 'item-json)) - (account (mastodon-tl--field 'account toot)) - (account-id (mastodon-tl--field 'id account)) - (handle (mastodon-tl--field 'acct account))) - (mastodon-views-add-account-to-list nil account-id handle))) - -(defun mastodon-views-remove-account-from-list-at-point () - "Prompt for account and remove from list at point." - (interactive) - (let ((id (mastodon-tl--property 'list-id :no-move))) - (mastodon-views-remove-account-from-list id))) - -(defun mastodon-views-remove-account-from-list (&optional id) - "Prompt for a list, select an account and remove from list. -If ID is provided, use that list." - (interactive) - (let* ((list-name (if id - (mastodon-tl--property 'list-name :no-move) - (completing-read "Remove account from list: " - (mastodon-views--get-lists-names) nil t))) - (list-id (or id (mastodon-views--get-list-id list-name))) - (accounts (mastodon-views--accounts-in-list list-id)) - (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id accounts)) - (account (completing-read "Account to remove: " handles nil t)) - (account-id (alist-get account handles)) - (url (mastodon-http--api (format "lists/%s/accounts" list-id))) - (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) - (response (mastodon-http--delete url args))) - (mastodon-views--list-action-triage - response "%s removed from list %s!" account list-name))) - -(defun mastodon-views--list-action-triage (response &rest args) - "Call `mastodon-http--triage' on RESPONSE and call message on ARGS." - (mastodon-http--triage response - (lambda (_) - (when (mastodon-tl--buffer-type-eq 'lists) - (mastodon-views-view-lists)) - (apply #'message args)))) - -(defun mastodon-views--accounts-in-list (list-id) - "Return the JSON of the accounts in list with LIST-ID." - (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) - (mastodon-http--get-json url))) - - -;;; 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))) - - -;;; SCHEDULED TOOTS - -;;;###autoload -(defun mastodon-views-view-scheduled-toots () - "Show the user's scheduled toots in a new buffer." - (interactive) - (mastodon-tl--init-sync "scheduled-toots" - "scheduled_statuses" - 'mastodon-views--insert-scheduled-toots - nil nil nil - "your scheduled toots" - "n/p - prev/next\n r - reschedule\n\ - e/RET - edit toot\n c - cancel") - (with-current-buffer "*mastodon-scheduled-toots*" - (use-local-map mastodon-views--scheduled-map))) - -(defun mastodon-views--insert-scheduled-toots (json) - "Insert the user's scheduled toots, from JSON." - (mastodon-views--minor-view - "scheduled toots" - #'mastodon-views--insert-scheduled-toots-list - json)) - -(defun mastodon-views--insert-scheduled-toots-list (scheduleds) - "Insert scheduled toots in SCHEDULEDS." - (mapc #'mastodon-views--insert-scheduled-toot scheduleds)) - -(defun mastodon-views--insert-scheduled-toot (toot) - "Insert scheduled TOOT into the buffer." - (let-alist toot - (insert - (propertize (concat (string-trim .params.text) - " | " - (mastodon-toot--iso-to-human .scheduled_at)) - 'byline t ; so we nav here - 'item-type 'scheduled ; so we nav here - 'face 'mastodon-toot-docs-face - 'keymap mastodon-views--scheduled-map - 'item-json toot - 'id .id) - "\n"))) - -(defun mastodon-views--get-scheduled-toots (&optional id) - "Get the user's currently scheduled toots. -If ID, just return that toot." - (let* ((endpoint (if id - (format "scheduled_statuses/%s" id) - "scheduled_statuses")) - (url (mastodon-http--api endpoint))) - (mastodon-http--get-json url))) - -(defun mastodon-views-reschedule-toot () - "Reschedule the scheduled toot at point." - (interactive) - (mastodon-tl--do-if-item - (mastodon-toot-schedule-toot :reschedule))) - -(defun mastodon-views-copy-scheduled-toot-text () - "Copy the text of the scheduled toot at point." - (interactive) - (let* ((toot (mastodon-tl--property 'toot :no-move)) - (params (alist-get 'params toot)) - (text (alist-get 'text params))) - (kill-new text))) - -(defun mastodon-views-cancel-scheduled-toot (&optional id no-confirm) - "Cancel the scheduled toot at point. -ID is that of the scheduled toot to cancel. -NO-CONFIRM means there is no ask or message, there is only do." - (interactive) - (mastodon-tl--do-if-item - (when (or no-confirm - (y-or-n-p "Cancel scheduled toot?")) - (let* ((id (or id (mastodon-tl--property 'id :no-move))) - (url (mastodon-http--api (format "scheduled_statuses/%s" id))) - (response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda (_) - (mastodon-views-view-scheduled-toots) - (unless no-confirm - (message "Toot cancelled!")))))))) - -(defun mastodon-views-edit-scheduled-as-new () - "Edit scheduled status as new toot." - (interactive) - (mastodon-tl--do-if-item - (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) - (id (mastodon-tl--property 'id :no-move)) - (scheduled (alist-get 'scheduled_at toot))) - (let-alist (alist-get 'params toot) - ;; TODO: preserve polls - ;; (poll (alist-get 'poll params)) - (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) - (goto-char (point-max)) - ;; adopt properties from scheduled toot: - (mastodon-toot--set-toot-properties - .in_reply_to_id .visibility .spoiler_text .language - scheduled id (alist-get 'media_attachments toot)))))) - - -;;; FILTERS - -;;;###autoload -(defun mastodon-views-view-filters () - "View the user's filters in a new buffer." - (interactive) - (mastodon-tl--init-sync "filters" "filters" - 'mastodon-views--insert-filters - nil nil nil - "current filters" - "c/u - create/update filter | d/k - delete filter\ - at point\n a/r/U - add/remove/Update filter keyword\n\ - n/p - next/prev filter" "v2") - (with-current-buffer "*mastodon-filters*" - (use-local-map mastodon-views--view-filters-keymap))) - -(defun mastodon-views--insert-filters (json) - "Insert a filter string plus a blank line. -JSON is the filters data." - (mapc #'mastodon-views--insert-filter json)) - -(require 'table) - -(defun mastodon-views--insert-filter-kws (kws) - "Insert filter keywords KWS." - (insert "\n") - (let ((beg (point)) - (table-cell-horizontal-chars (if (char-displayable-p ?–) - "–" - "-")) - (whole-str "whole words only:")) - (insert (concat "Keywords: | " whole-str "\n")) - (cl-loop for kw in kws - do (let ((whole (if (eq :json-false (alist-get 'whole_word kw)) - "nil" - "t"))) - (insert - (propertize (concat - (format "\"%s\" | %s\n" - (alist-get 'keyword kw) whole)) - 'kw-id (alist-get 'id kw) - 'item-json kw - 'mastodon-tab-stop t - 'whole-word whole)))) - ;; table display of kws: - (table-capture beg (point) "|" "\n" nil (+ 2 (length whole-str))) - (table-justify-column 'center) - (table-forward-cell) ;; col 2 - (table-justify-column 'center) - (while (re-search-forward ;; goto end of table: - (concat table-cell-horizontal-chars - (make-string 1 table-cell-intersection-char) - "\n") - nil :no-error)))) - -(defun mastodon-views--insert-filter (filter) - "Insert a single FILTER." - (let-alist filter - (insert - ;; FIXME: awful hack to fix nav: exclude horiz-bar from propertize then - ;; propertize rest of the filter text. if we add only byline prop to - ;; title, point will move to end of title, because at that byline-prop - ;; change, item-type prop is present. - (mastodon-tl--set-face - (concat "\n " mastodon-tl--horiz-bar "\n ") - 'success) - (propertize - (concat - ;; heading: - (mastodon-tl--set-face - (concat (upcase .title) " " "\n " - mastodon-tl--horiz-bar "\n") - 'success) - ;; context: - (concat "Context: " (mapconcat #'identity .context ", ")) - ;; type (warn or hide): - (concat "\nType: " .filter_action)) - 'item-json filter - 'byline t - 'item-id .id - 'filter-title .title - 'item-type 'filter)) - ;; terms list: - (when .keywords ;; poss to have no keywords - (mastodon-views--insert-filter-kws .keywords)))) - -(defvar mastodon-views--filter-types - '("home" "notifications" "public" "thread" "profile")) - -(defun mastodon-views-create-filter (&optional id title context type terms) - "Create a filter for a word. -Prompt for a context, must be a list containting at least one of \"home\", -\"notifications\", \"public\", \"thread\". -Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." - (interactive) - ;; ID non-nil = we are updating - (let* ((url (mastodon-http--api-v2 - (if id (format "filters/%s" id) "filters"))) - (title (or title (read-string "Filter name: "))) - (terms (or terms - (read-string "Terms to filter (comma or space separated): "))) - (terms-split (split-string terms "[, ]")) - (terms-processed - (if (not terms) ;; well actually it is poss to have no terms - (user-error "You must select at least one term") - (mastodon-http--build-array-params-alist - "keywords_attributes[][keyword]" terms-split))) - (warn-or-hide - (or type (completing-read "Warn (like CW) or hide? " - '("warn" "hide") nil :match))) - ;; TODO: display "home (and lists)" but just use "home" for API - (contexts - (or context (completing-read-multiple - "Filter contexts [TAB for options, comma separated]: " - mastodon-views--filter-types nil :match))) - (contexts-processed - (if (not contexts) - (user-error "You must select at least one context") - (mastodon-http--build-array-params-alist "context[]" contexts))) - (params (append `(("title" . ,title) - ("filter_action" . ,warn-or-hide)) - terms-processed - contexts-processed)) - (resp (if id - (mastodon-http--put url params) - (mastodon-http--post url params)))) - (mastodon-views--filters-triage - resp - (message "Filter %s %s!" title (if id "updated" "created"))))) - -(defun mastodon-views-update-filter () - "Update filter at point." - (interactive) - (if (not (eq 'filter (mastodon-tl--property 'item-type))) - (user-error "No filter at point?") - (let* ((filter (mastodon-tl--property 'item-json)) - (id (mastodon-tl--property 'item-id)) - (name (read-string "Name: " (alist-get 'title filter))) - (contexts (completing-read-multiple - "Filter contexts [TAB for options, comma separated]: " - mastodon-views--filter-types nil :match - (mapconcat #'identity - (alist-get 'context filter) ","))) - (type (completing-read "Warn (like CW) or hide? " - '("warn" "hide") nil :match - (alist-get 'type filter))) - (terms (read-string "Terms to add (comma or space separated): "))) - (mastodon-views-create-filter id name contexts type terms)))) - -(defun mastodon-views-delete-filter () - "Delete filter at point." - (interactive) - (let* ((id (mastodon-tl--property 'item-id :no-move)) - (title (mastodon-tl--property 'filter-title :no-move)) - (url (mastodon-http--api-v2 (format "filters/%s" id)))) - (if (not (eq 'filter (mastodon-tl--property 'item-type))) - (user-error "No filter at point?") - (when (y-or-n-p (format "Delete filter %s? " title)) - (let ((resp (mastodon-http--delete url))) - (mastodon-views--filters-triage - resp - (message "Filter \"%s\" deleted!" title))))))) - -(defun mastodon-views--get-filter-kw (&optional id) - "GET filter with ID." - (let* ((id (or id (mastodon-tl--property 'kw-id :no-move))) - (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) - (resp (mastodon-http--get-json url))) - resp)) - -(defun mastodon-views-update-filter-kw () - "Update filter keyword. -Prmopt to change the term, and the whole words option. -When t, whole words means only match whole words." - (interactive) - (if (not (eq 'filter (mastodon-tl--property 'item-type))) - (user-error "No filter at point?") - (let* ((kws (alist-get 'keywords - (mastodon-tl--property 'item-json :no-move))) - (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws)) - (choice (completing-read "Update keyword: " alist)) - (updated (read-string "Keyword: " choice)) - (whole-word (if (y-or-n-p "Match whole words only? ") - "true" - "false")) - (params `(("keyword" . ,updated) - ("whole_word" . ,whole-word))) - (id (cdr (assoc choice alist #'string=))) - (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) - (resp (mastodon-http--put url params))) - (mastodon-views--filters-triage resp - (format "Keyword %s updated!" updated))))) - -(defun mastodon-views--filters-triage (resp msg-str) - "Triage filter action response RESP, reload filters, message MSG-STR." - (mastodon-http--triage - resp - (lambda (_resp) - (when (mastodon-tl--buffer-type-eq 'filters) - (mastodon-views-view-filters)) - (message msg-str)))) - -(defun mastodon-views-add-filter-kw () - "Add a keyword to filter at point." - (interactive) - (if (not (eq 'filter (mastodon-tl--property 'item-type))) - (user-error "No filter at point?") - (let* ((kw (read-string "Keyword: ")) - (id (mastodon-tl--property 'item-id :no-move)) - (whole-word (if (y-or-n-p "Match whole words only? ") - "true" - "false")) - (params `(("keyword" . ,kw) - ("whole_word" . ,whole-word))) - (url (mastodon-http--api-v2 (format "filters/%s/keywords" id))) - (resp (mastodon-http--post url params))) - (mastodon-views--filters-triage resp - (format "Keyword %s added!" kw))))) - -(defun mastodon-views-remove-filter-kw () - "Remove keyword from filter at point." - (interactive) - (if (not (eq 'filter (mastodon-tl--property 'item-type))) - (user-error "No filter at point?") - (let* ((kws (alist-get 'keywords - (mastodon-tl--property 'item-json :no-move))) - (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws)) - (choice (completing-read "Remove keyword: " alist)) - (id (cdr (assoc choice alist #'string=))) - (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) - (resp (mastodon-http--delete url))) - (mastodon-views--filters-triage resp (format "Keyword %s removed!" choice))))) - - -;;; 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)) - - -;;; INSTANCES - -(defun mastodon-views-view-own-instance (&optional brief) - "View details of your own instance. -BRIEF means show fewer details." - (interactive) - (mastodon-views-view-instance-description :user brief)) - -(defun mastodon-views-view-own-instance-brief () - "View brief details of your own instance." - (interactive) - (mastodon-views-view-instance-description :user :brief)) - -(defun mastodon-views-view-instance-description-brief () - "View brief details of the instance the current post's author is on." - (interactive) - (mastodon-views-view-instance-description nil :brief)) - -(defun mastodon-views--get-instance-url (url username &optional instance) - "Return an instance base url from a user account URL. -USERNAME is the name to cull. -If INSTANCE is given, use that." - (cond (instance (concat "https://" instance)) - ;; pleroma URL is https://instance.com/users/username - ((string-suffix-p "users/" (url-basepath url)) - (string-remove-suffix "/users/" - (url-basepath url))) - ;; friendica is https://instance.com/profile/user - ((string-suffix-p "profile/" (url-basepath url)) - (string-remove-suffix "/profile/" - (url-basepath url))) - ;; snac is https://instance.com/user - ((not (string-match-p "@" url)) - ;; cull trailing slash: - (string-trim-right (url-basepath url) "/")) - ;; mastodon is https://instance.com/@user - (t - (string-remove-suffix (concat "/@" username) - url)))) - -(defun mastodon-views--get-own-instance () - "Return JSON of `mastodon-active-user's instance." - (mastodon-http--get-json - (mastodon-http--api "instance" "v2") nil nil :vector)) - -(defun mastodon-views-view-instance-description - (&optional user brief instance misskey) - "View the details of the instance the current post's author is on. -USER means to show the instance details for the logged in user. -BRIEF means to show fewer details. -INSTANCE is an instance domain name. -MISSKEY means the instance is a Misskey or derived server." - (interactive) - (if user - (let ((response (mastodon-views--get-own-instance))) - (mastodon-views--instance-response-fun response brief instance)) - (mastodon-tl--do-if-item - (let* ((toot (or (and (mastodon-tl--profile-buffer-p) - (mastodon-tl--property 'profile-json)) ; either profile - (mastodon-tl--property 'item-json))) ; or toot or user listing - (reblog (alist-get 'reblog toot)) - (account (or (alist-get 'account reblog) - (alist-get 'account toot) - toot)) ; else `toot' is already an account listing. - ;; we may be at toots/boosts/users in a profile buffer. - ;; profile-json is a defacto test for if point is on the profile - ;; details at the top of a profile buffer. - (profile-note-p (and (mastodon-tl--profile-buffer-p) - ;; only call this in profile buffers: - (mastodon-tl--property 'profile-json))) - (url (if profile-note-p - (alist-get 'url toot) ; profile description - (alist-get 'url account))) - (username (if profile-note-p - (alist-get 'username toot) ;; profile - (alist-get 'username account))) - (instance (mastodon-views--get-instance-url url username instance))) - (if misskey - (let* ((params `(("detail" . ,(or brief t)))) - (headers '(("Content-Type" . "application/json"))) - (url (concat instance "/api/meta")) - (response - (with-current-buffer (mastodon-http--post url params headers t :json) - (mastodon-http--process-response)))) - (mastodon-views--instance-response-fun response brief instance :misskey)) - (let ((response (mastodon-http--get-json - (concat instance "/api/v1/instance") nil nil :vector))) - ;; if non-misskey attempt errors, try misskey instance: - ;; akkoma i guess should not error here. - (if (eq 'error (caar response)) - (mastodon-views-instance-desc-misskey) - (mastodon-views--instance-response-fun response brief instance)))))))) - -(defun mastodon-views-instance-desc-misskey (&optional user brief instance) - "Show instance description for a misskey/firefish server. -USER, BRIEF, and INSTANCE are all for -`mastodon-views-view-instance-description', which see." - (interactive) - (mastodon-views-view-instance-description user brief instance :miskey)) - -(defun mastodon-views--instance-response-fun (response brief instance - &optional misskey) - "Display instance description RESPONSE in a new buffer. -BRIEF means to show fewer details. -INSTANCE is the instance were are working with. -MISSKEY means the instance is a Misskey or derived server." - (when response - (let* ((domain (url-file-nondirectory instance)) - (buf (get-buffer-create - (format "*mastodon-instance-%s*" domain)))) - (with-mastodon-buffer buf #'special-mode :other-window - (if misskey - (mastodon-views--insert-json response) - (condition-case nil - (progn - (when brief - (setq response - (list (assoc 'uri response) - (assoc 'title response) - (assoc 'short_description response) - (assoc 'email response) - (cons 'contact_account - (list - (assoc 'username - (assoc 'contact_account response)))) - (assoc 'rules response) - (assoc 'stats response)))) - (mastodon-views--print-json-keys response) - (mastodon-tl--set-buffer-spec (buffer-name buf) "instance" nil) - (goto-char (point-min))) - (error ; just insert the raw response: - (mastodon-views--insert-json response)))))))) - -(defun mastodon-views--insert-json (response) - "Insert raw JSON RESPONSE in current buffer." - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (prin1-to-string response)) - (pp-buffer) - (goto-char (point-min)))) - -(defun mastodon-views--format-key (el pad) - "Format a key of element EL, a cons, with PAD padding." - (format (concat "%-" - (number-to-string pad) - "s: ") - (propertize (prin1-to-string (car el)) - 'face '(:underline t)))) - -(defun mastodon-views--print-json-keys (response &optional ind) - "Print the JSON keys and values in RESPONSE. -IND is the optional indentation level to print at." - (let* ((cars (mapcar (lambda (x) (symbol-name (car x))) - response)) - (pad (1+ (apply #'max (mapcar #'length cars))))) - (while response - (let ((el (pop response))) - (cond - ((and (vectorp (cdr el)) ; vector of alists (fields, instance rules): - (not (seq-empty-p (cdr el))) - (consp (seq-elt (cdr el) 0))) - (insert (mastodon-views--format-key el pad) - "\n\n") - (seq-do #'mastodon-views--print-instance-rules-or-fields (cdr el)) - (insert "\n")) - ((and (vectorp (cdr el)) ; vector of strings (media types): - (not (seq-empty-p (cdr el))) - (< 1 (seq-length (cdr el))) - (stringp (seq-elt (cdr el) 0))) - (when ind (indent-to ind)) - (insert (mastodon-views--format-key el pad) - "\n" - (seq-mapcat - (lambda (x) (concat x ", ")) - (cdr el) 'string) - "\n\n")) - ((consp (cdr el)) ; basic nesting: - (when ind (indent-to ind)) - (insert (mastodon-views--format-key el pad) - "\n\n") - (mastodon-views--print-json-keys - (cdr el) (if ind (+ ind 4) 4))) - (t ; basic handling of raw booleans: - (let ((val (cond ((eq (cdr el) :json-false) - "no") - ((eq (cdr el) t) - "yes") - (t - (cdr el))))) - (when ind (indent-to ind)) - (insert (mastodon-views--format-key el pad) - " " - (mastodon-views--newline-if-long (cdr el)) - ;; only send strings to --render-text (for hyperlinks): - (mastodon-tl--render-text - (if (stringp val) val (prin1-to-string val))) - "\n")))))))) - -(defun mastodon-views--print-instance-rules-or-fields (alist) - "Print ALIST of instance rules or contact account or emoji fields." - (let-alist alist - (let ((key (or .id .name .shortcode)) - (value (or .text .value .url))) - (indent-to 4) - (insert (format "%-5s: " - (propertize key 'face '(:underline t))) - (mastodon-views--newline-if-long value) - (format "%s" (mastodon-tl--render-text - value)) - "\n")))) - -(defun mastodon-views--newline-if-long (el) - "Return a newline string if the cdr of EL is over 50 characters long." - (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) - (if (and (sequencep rend) - (< 50 (length rend))) - "\n" - ""))) - -(provide 'mastodon-views) -;;; mastodon-views.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon-widget.el b/elpa/mastodon-20251201.1553/mastodon-widget.el deleted file mode 100644 index e9376d8a..00000000 --- a/elpa/mastodon-20251201.1553/mastodon-widget.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; mastodon-widget.el --- Widget utilities -*- lexical-binding: t -*- - -;; Copyright (C) 2020-2024 Marty Hiatt -;; Author: Marty Hiatt -;; Maintainer: Marty Hiatt -;; 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 . - -;;; 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 diff --git a/elpa/mastodon-20251201.1553/mastodon.el b/elpa/mastodon-20251201.1553/mastodon.el deleted file mode 100644 index c58e0466..00000000 --- a/elpa/mastodon-20251201.1553/mastodon.el +++ /dev/null @@ -1,587 +0,0 @@ -;;; 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 -;; Author: Johnson Denen -;; Marty Hiatt -;; Maintainer: Marty Hiatt -;; Package-Version: 20251201.1553 -;; Package-Revision: 3c00418bfbb1 -;; Package-Requires: ((emacs "28.1") (persist "0.8") (tp "0.7")) -;; Homepage: https://codeberg.org/martianh/mastodon.el - -;; This file is not part of GNU Emacs. - -;; This file is part of mastodon.el. - -;; mastodon.el is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; mastodon.el is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with mastodon.el. If not, see . - -;;; Commentary: - -;; mastodon.el is a client for fediverse services that implement the Mastodon -;; API. See . - -;; For set up and usage details, see the Info documentation, or the readme -;; file at . - -;;; Code: -(require 'cl-lib) ; for `cl-some' call in `mastodon' -(eval-when-compile (require 'subr-x)) -(require 'url) -(require 'thingatpt) -(require 'shr) - -(require 'mastodon-http) -(require 'mastodon-toot) -(require 'mastodon-search) -(require 'mastodon-transient) -(require 'mastodon-tl) - -(declare-function discover-add-context-menu "discover") -(declare-function emojify-mode "emojify") -(declare-function request "request") - -(autoload 'mastodon-auth--get-account-name "mastodon-auth") -(autoload 'mastodon-auth--user-acct "mastodon-auth") -(autoload 'mastodon-discover "mastodon-discover") -(autoload 'mastodon-notifications-follow-request-accept "mastodon-notifications") -(autoload 'mastodon-notifications-follow-request-reject "mastodon-notifications") -(autoload 'mastodon-notifications-get-mentions "mastodon-notifications") -(autoload 'mastodon-notifications--timeline "mastodon-notifications") -(autoload 'mastodon-notifications-policy "mastodon-notifications") -(autoload 'mastodon-notifications-requests "mastodon-notifications") -(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") -(autoload 'mastodon-profile-get-toot-author "mastodon-profile") -(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") -(autoload 'mastodon-profile-my-profile "mastodon-profile") -(autoload 'mastodon-profile-show-user "mastodon-profile") -(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile") -(autoload 'mastodon-profile-view-bookmarks "mastodon-profile") -(autoload 'mastodon-profile-view-favourites "mastodon-profile") -(autoload 'mastodon-toot-edit-toot-at-point "mastodon-toot") -(when (require 'lingva nil :no-error) - (autoload 'mastodon-toot-translate-toot-text "mastodon-toot")) -(autoload 'mastodon-toot--view-toot-history "mastodon-tl") -(autoload 'mastodon-tl-return "mastodon-tl") -(autoload 'mastodon-tl-jump-to-followed-tag "mastodon-tl") - -;; for M-x visibility -;; (views.el uses `mastodon-mode-map', so we can't easily require it) -(autoload 'mastodon-views-view-follow-suggestions "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-view-filters "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-view-follow-requests "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-view-own-instance "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-view-instance-description "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-view-lists "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-view-scheduled-toots "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-add-account-to-list "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-add-toot-account-at-point-to-list "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-create-list "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-create-filter "mastodon-views" - nil :interactive) -(autoload 'mastodon-views-view-list-timeline "mastodon-views" - nil :interactive) - -(autoload 'special-mode "simple") - -(defvar mastodon-tl--highlight-current-toot) -(defvar mastodon-notifications--map) -(defvar mastodon-client--token-file) - -(defvar mastodon-notifications-grouped-types - '("reblog" "favourite") ;; TODO: implement follow! - "List of notification types for which grouping is implemented. -Used in `mastodon-notifications-get'") - -(defgroup mastodon nil - "Interface with Mastodon." - :prefix "mastodon-" - :group 'external) - -(defcustom mastodon-instance-url "https://mastodon.social" - "Base URL for the fediverse instance you want to be active. -For example, if your username is -\"example_user@social.instance.org\", and you want this account -to be active, the value of this variable should be -\"https://social.instance.org\". - -Also for completeness, the value of `mastodon-active-user' should -be \"example_user\". - -After setting these variables you should restart Emacs for these -changes to take effect." - :type 'string) - -(defcustom mastodon-active-user nil - "Username of the active user. -For example, if your username is -\"example_user@social.instance.org\", and you want this account -to be active, the value of this variable should be -\"example_user\". - -Also for completeness, the value of `mastodon-instance-url' -should be \"https://social.instance.org\". - -After setting these variables you should restart Emacs for these -changes to take effect." - :type 'string) - -(defcustom mastodon-toot-timestamp-format "%F %T" - "Format to use for timestamps. -For valid formatting options see `format-time-string`. -The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS. -Use. e.g. \"%c\" for your locale's date and time format." - :type 'string) - -(defcustom mastodon-use-emojify nil - "Whether to use emojify.el to display emojis. -From version 28, Emacs can display emojis natively. But -currently, it doesn't seem to have a way to handle custom emoji, -while emojify,el has this feature and mastodon.el implements it." - :type 'boolean) - -;; notifications customizes -;; moved here because we can load notifs without first loading mastodon.el -;; or mastodon-notifications.el - -(defcustom mastodon-profile-note-in-foll-reqs t - "If non-nil, show a user's profile note in follow request notifications." - :type '(boolean)) - -(defcustom mastodon-profile-note-in-foll-reqs-max-length nil - "The max character length for user profile note in follow requests. -Profile notes are only displayed if -`mastodon-profile-note-in-foll-reqs' is non-nil. -If unset, profile notes of any size will be displayed, which may -make them unweildy." - :type '(integer)) - -(defcustom mastodon-images-in-notifs nil - "Whether to display attached images in notifications." - :type '(boolean)) - -(defcustom mastodon-group-notifications nil - "Whether to use grouped notifications. -Requires that your instance actually implements grouped notifications. -Mastodon implemented them in 4.3." - :type '(boolean)) - -(defcustom mastodon-notifications-grouped-names-count 2 - "The number of notification authors to display. -A count of 2 for example means to display like so: \"Bob, Jenny -and X others...\"." - :type '(integer)) - -(defun mastodon-kill-window () - "Quit window and delete helper." - (interactive) - (quit-window 'kill)) - -(defvar mastodon-client--active-user-details-plist) -(defvar mastodon-auth--token-alist) - -;;;###autoload -(defun mastodon-forget-all-logins () - "Delete `mastodon-client--token-file'. -Also nil `mastodon-auth--token-alist'." - (interactive) - (when (y-or-n-p "Remove all saved login data?") - (if (not (file-exists-p mastodon-client--token-file)) - (message "No plstore file") - (delete-file mastodon-client--token-file) - (message "File %s deleted." mastodon-client--token-file)) - ;; nil some vars too: - (setq mastodon-client--active-user-details-plist nil) - (setq mastodon-auth--token-alist nil))) - -(defvar mastodon-mode-map - (let ((map (make-sparse-keymap))) - ;; navigation inside a timeline - (define-key map (kbd "n") #'mastodon-tl-goto-next-item) - (define-key map (kbd "p") #'mastodon-tl-goto-prev-item) - (define-key map (kbd "M-n") #'mastodon-tl-next-tab-item) - (define-key map (kbd "M-p") #'mastodon-tl-previous-tab-item) - (define-key map [?\t] #'mastodon-tl-next-tab-item) - (define-key map [backtab] #'mastodon-tl-previous-tab-item) - (define-key map [?\S-\t] #'mastodon-tl-previous-tab-item) - (define-key map [?\M-\t] #'mastodon-tl-previous-tab-item) - (define-key map (kbd "l") #'recenter-top-bottom) - ;; navigation between timelines - (define-key map (kbd "#") #'mastodon-tl-get-tag-timeline) - (define-key map (kbd "\"") #'mastodon-tl-list-followed-tags) - (define-key map (kbd "C-\"") #'mastodon-tl-jump-to-followed-tag) - (define-key map (kbd "'") #'mastodon-tl-followed-tags-timeline) - (define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline) - (define-key map (kbd "A") #'mastodon-profile-get-toot-author) - (define-key map (kbd "F") #'mastodon-tl-get-federated-timeline) - (define-key map (kbd "H") #'mastodon-tl-get-home-timeline) - (define-key map (kbd "L") #'mastodon-tl-get-local-timeline) - (define-key map (kbd "N") #'mastodon-notifications-get) - (define-key map (kbd "S-C-n") #'mastodon-notifications-requests) - (define-key map (kbd "@") #'mastodon-notifications-get-mentions) - (define-key map (kbd "P") #'mastodon-profile-show-user) - (define-key map (kbd "s") #'mastodon-search-query) - (define-key map (kbd "/") #'mastodon-switch-to-buffer) - (define-key map (kbd "\\") #'mastodon-tl-get-remote-local-timeline) - ;; quitting mastodon - (define-key map (kbd "q") #'kill-current-buffer) - (define-key map (kbd "Q") #'mastodon-kill-window) - (define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers) - ;; toot actions - (define-key map (kbd "c") #'mastodon-tl-toggle-spoiler-text-in-toot) - (define-key map (kbd "b") #'mastodon-toot-toggle-boost) - (define-key map (kbd "f") #'mastodon-toot-toggle-favourite) - (define-key map (kbd "k") #'mastodon-toot-toggle-bookmark) - (define-key map (kbd "r") #'mastodon-toot-reply) - (define-key map (kbd "C") #'mastodon-toot-copy-toot-url) - (define-key map (kbd "o") #'mastodon-toot-browse-toot-url) - (define-key map (kbd "v") #'mastodon-tl-poll-vote) - (define-key map (kbd "E") #'mastodon-toot-view-toot-edits) - (define-key map (kbd "T") #'mastodon-tl-thread) - (define-key map (kbd "RET") #'mastodon-tl-return) - (define-key map (kbd "m") #'mastodon-tl-dm-user) - (define-key map (kbd "=") #'mastodon-tl-view-first-full-image) - (when (require 'lingva nil :no-error) - (define-key map (kbd "a") #'mastodon-toot-translate-toot-text)) - (define-key map (kbd ",") #'mastodon-toot-list-favouriters) - (define-key map (kbd ".") #'mastodon-toot-list-boosters) - (define-key map (kbd ";") #'mastodon-views-view-instance-description) - (define-key map (kbd "M-;") #'mastodon-tl-nodeinfo-for-toot) - ;; override special mode binding - (define-key map (kbd "g") #'undefined) - (define-key map (kbd "g") #'mastodon-tl-update) - ;; this is now duplicated by 'g', cd remove/use for else: - (define-key map (kbd "u") #'mastodon-tl-update) - ;; own toot actions: - (define-key map (kbd "t") #'mastodon-toot) - (define-key map (kbd "d") #'mastodon-toot-delete-toot) - (define-key map (kbd "D") #'mastodon-toot-delete-and-redraft-toot) - (define-key map (kbd "i") #'mastodon-toot-pin-toot-toggle) - (define-key map (kbd "e") #'mastodon-toot-edit-toot-at-point) - ;; user actions - (define-key map (kbd "W") #'mastodon-tl-follow-user) - (define-key map (kbd "C-S-W") #'mastodon-tl-unfollow-user) - (define-key map (kbd "B") #'mastodon-tl-block-user) - (define-key map (kbd "C-S-B") #'mastodon-tl-unblock-user) - (define-key map (kbd "M") #'mastodon-tl-mute-user) - (define-key map (kbd "C-S-M") #'mastodon-tl-unmute-user) - (define-key map (kbd "Z") #'mastodon-tl-report-to-mods) - ;; own profile - (define-key map (kbd "O") #'mastodon-profile-my-profile) - (define-key map (kbd "U") #'mastodon-profile-update-user-profile-note) - (define-key map (kbd "V") #'mastodon-profile-view-favourites) - (define-key map (kbd "K") #'mastodon-profile-view-bookmarks) - (define-key map (kbd ":") #'mastodon-user-settings) - (define-key map (kbd "C-:") #'mastodon-notifications-policy) - ;; minor views - (define-key map (kbd "R") #'mastodon-views-view-follow-requests) - (define-key map (kbd "S") #'mastodon-views-view-scheduled-toots) - (define-key map (kbd "I") #'mastodon-views-view-filters) - (define-key map (kbd "G") #'mastodon-views-view-follow-suggestions) - (define-key map (kbd "X") #'mastodon-views-view-lists) - (define-key map (kbd "SPC") #'mastodon-tl-scroll-up-command) - (define-key map (kbd "!") #'mastodon-tl-fold-post-toggle) - (define-key map (kbd "z") #'bury-buffer) - map) - "Keymap for `mastodon-mode'.") - -(defcustom mastodon-mode-hook nil - "Hook run when entering Mastodon mode." - :type 'hook - :options '(provide-discover-context-menu)) - -(defface mastodon-handle-face - '((t :inherit default)) - "Face used for user handles in bylines.") - -(defface mastodon-display-name-face - '((t :inherit warning)) - "Face used for user display names.") - -(defface mastodon-boosted-face - '((t :inherit success :weight bold)) - "Face to indicate that a toot is boosted.") - -(defface mastodon-boost-fave-face - '((t :inherit success)) - "Face to indicate that you have boosted or favourited a toot.") - -(defface mastodon-cw-face - '((t :inherit success)) - "Face used for content warning.") - -(defface mastodon-toot-docs-face - `((t :inherit shadow)) - "Face used for documentation in toot compose buffer. -If `mastodon-tl--enable-proportional-fonts' is changed, -mastodon.el needs to be re-loaded for this to be correctly set.") - -(defface mastodon-toot-docs-reply-text-face - `((t :inherit font-lock-comment-face - :family ,(face-attribute 'variable-pitch :family))) - "Face used for reply text in toot compose buffer. -See `mastodon-toot-display-orig-in-reply-buffer'.") - -(defface mastodon-cursor-highlight-face - `((t :inherit highlight :extend t)) - "Face for `mastodon-tl--highlight-current-toot'.") - -;;;###autoload -(defun mastodon () - "Connect client to `mastodon-instance-url' instance. -If there are any open mastodon.el buffers, switch to one instead. -Prority in switching is given to timeline views." - (interactive) - (let* ((tls (list "home" - "local" - "federated" - (concat (mastodon-auth--user-acct) "-statuses") ; own profile - "favourites" - "search")) - (buffer (or (cl-some (lambda (el) - (get-buffer (concat "*mastodon-" el "*"))) - tls) ; return first buff that exists - (cl-some (lambda (x) - (when (string-prefix-p "*mastodon-" - (buffer-name x)) - (get-buffer x))) - (buffer-list))))) ; catch any other masto buffer - (if buffer - (pop-to-buffer buffer '(display-buffer-same-window)) - ;; we need to update credential-account in case setting have been changed - ;; outside mastodon.el in the meantime: - (mastodon-return-credential-account :force) - (mastodon-tl-get-home-timeline) - (message "Loading fediverse account %s on %s..." - (mastodon-auth--user-acct) - mastodon-instance-url)))) - -(defvar mastodon-profile-credential-account nil) - -;; TODO: the get request in mastodon-http--get-response often returns nil -;; after waking from sleep, not sure how to fix, or if just my pc. -;; interestingly it only happens with this function tho. -(defun mastodon-return-credential-account (&optional force) - "Return the CredentialAccount entity. -Either from `mastodon-profile-credential-account' or from the -server if that var is nil. -FORCE means to fetch from the server in any case and update -`mastodon-profile-credential-account'." - (if (or force (not mastodon-profile-credential-account)) - (setq mastodon-profile-credential-account - ;; TODO: we should signal a quit condition after 5 secs here - (condition-case nil - (mastodon-http--get-json - (mastodon-http--api "accounts/verify_credentials") - nil :silent) - (t ; req fails, return old value - mastodon-profile-credential-account))) - ;; else just return the var: - mastodon-profile-credential-account)) - -(defvar mastodon-instance-data nil - "Instance data from the instance endpoint.") - -(defun mastodon-instance-data () - "Return `mastodon-instnace-data' or else fetch from instance endpoint." - (or mastodon-instance-data - (setq mastodon-instance-data - (mastodon-http--get-json (mastodon-http--api "instance"))))) - -(defun mastodon-instance-version () - "Return the version string of user's instance." - (alist-get 'version (mastodon-instance-data))) - -;;;###autoload -(defun mastodon-toot (&optional user reply-to-id reply-json) - "Update instance with new toot. Content is captured in a new buffer. -If USER is non-nil, insert after @ symbol to begin new toot. -If REPLY-TO-ID is non-nil, attach new toot to a conversation. -If REPLY-JSON is the json of the toot being replied to." - (interactive) - (mastodon-toot--compose-buffer user reply-to-id reply-json)) - -;;;###autoload -(defun mastodon-notifications-get (&optional type buffer-name max-id) - "Display NOTIFICATIONS in buffer. -Optionally only print notifications of type TYPE, a string. -BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. -MAX-ID is a request parameter for pagination." - (interactive) - (let* ((buffer-name (or buffer-name "notifications")) - (buffer (concat "*mastodon-" buffer-name "*"))) - (message "Loading your notifications...") - (mastodon-tl--init-sync - buffer-name - "notifications" - 'mastodon-notifications--timeline - type - `(,@(when mastodon-group-notifications - (mastodon-http--build-array-params-alist - "grouped_types[]" mastodon-notifications-grouped-types)) - ,@(when max-id - `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))) - nil nil nil - (if (or (not mastodon-group-notifications) - ;; if version less than 1st grouped notifs release: - (> 4.3 (string-to-number - (mastodon-instance-version)))) - "v1" - "v2")) - (with-current-buffer (get-buffer-create buffer) - (use-local-map mastodon-notifications--map)) - (message "Loading your notifications... Done"))) - -;; URL lookup: should be available even if `mastodon.el' not loaded: - -;;;###autoload -(defun mastodon-url-lookup (&optional query-url force) - "If a URL resembles a fediverse link, try to load in `mastodon.el'. -Does a WebFinger lookup on the server. -URL can be arg QUERY-URL, or URL at point, or provided by the user. -If a status or account is found, load it in `mastodon.el', if -not, just browse the URL in the normal fashion. -If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'." - (interactive) - (let* ((query (or query-url - (mastodon-tl--property 'shr-url :no-move) - (thing-at-point-url-at-point) - (read-string "Lookup URL: ")))) - (if (and (not force) - (not (mastodon--fedi-url-p query))) - ;; (shr-browse-url query) ; doesn't work (keep our shr keymap) - (progn (message "Using external browser") - (browse-url query)) - (message "Performing lookup...") - (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) - (params `(("q" . ,query) - ("resolve" . "t"))) ; webfinger - (response (mastodon-http--get-json url params :silent))) - (cond ((not (seq-empty-p (alist-get 'statuses response))) - (let* ((statuses (assoc 'statuses response)) - (status (seq-first (cdr statuses))) - (status-id (alist-get 'id status))) - (mastodon-tl--thread-do status-id))) - ((not (seq-empty-p (alist-get 'accounts response))) - (let* ((accounts (assoc 'accounts response)) - (account (seq-first (cdr accounts)))) - (mastodon-profile--make-author-buffer account))) - (t - (message "Lookup failed. Using external browser") - (browse-url query))))))) - -(defun mastodon-url-lookup-force () - "Call `mastodon-url-lookup' without checking if URL is fedi-like." - (interactive) - (mastodon-url-lookup nil :force)) - -(defun mastodon--fedi-url-p (url) - "Check if QUERY resembles a fediverse URL." - ;; calqued off https://github.com/tuskyapp/Tusky/blob/c8fc2418b8f5458a817bba221d025b822225e130/app/src/main/java/com/keylesspalace/tusky/BottomSheetActivity.kt - ;; thx to Conny Duck! - ;; mastodon at least seems to allow only [a-z0-9_] for usernames, plus "." - ;; but not at beginning or end, see https://github.com/mastodon/mastodon/issues/6830 - ;; objects may have - in them - (let* ((uri-parsed (url-generic-parse-url url)) - (query (url-filename uri-parsed))) - (save-match-data - (or (string-match "^/@[^/]+$" query) - (string-match "^/@[^/]+/[[:digit:]]+$" query) - (string-match "^/user[s]?/@?[[:alnum:]_]+$" query) ; @: pleroma or soapbox - (string-match "^/notice/[[:alnum:]]+$" query) - (string-match "^/objects/[-a-f0-9]+$" query) - (string-match "^/notes/[a-z0-9]+$" query) - (string-match "^/display/[-a-f0-9]+$" query) - (string-match "^/profile/[[:alpha:]_]+$" query) - (string-match "^/p/[[:alpha:]_]+/[[:digit:]]+$" query) - (string-match "^/[[:alpha:]_]+$" query) - (string-match "^/u/[[:alpha:]_]+$" query) - (string-match "^/c/[[:alnum:]_]+$" query) - (string-match "^/post/[[:digit:]]+$" query) - (string-match "^/comment/[[:digit:]]+$" query) ; lemmy - (string-match "^/@[^/]+/statuses/[[:alnum:]]" query) ; GTS - (string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" query) ; hometown - (string-match "^/notes/[[:alnum:]]+$" query) ; misskey post - (string-match "^/w/[[:alnum:]_]+$" query) ; peertube post - ;; bsky via fed.brid.gy (unsure if this needs narrowing down?): - (string-prefix-p "https://fed.brid.gy/r/" url))))) - -(defun mastodon-live-buffers () - "Return a list of open mastodon buffers. -Calls `mastodon-tl--get-buffer-type', which see." - (cl-loop for x in (buffer-list) - when (with-current-buffer x (mastodon-tl--get-buffer-type)) - collect (get-buffer x))) - -(defun mastodon-buffer-p (&optional buffer) - "Non-nil if BUFFER or `current-buffer' is a mastodon one." - (let ((buf (or buffer (current-buffer)))) - (member buf (mastodon-live-buffers)))) - -(defun mastodon-kill-all-buffers () - "Kill any and all open mastodon buffers, hopefully." - (interactive) - (let ((mastodon-buffers (mastodon-live-buffers))) - (cl-loop for x in mastodon-buffers - do (kill-buffer x)))) - -(defun mastodon-switch-to-buffer () - "Switch to a live mastodon buffer." - (interactive) - (let ((choice (completing-read - "Switch to mastodon buffer: " - (mapcar #'buffer-name (mastodon-live-buffers)) - nil :match))) - (switch-to-buffer choice))) - -(defun mastodon--url-at-point () - "`thing-at-point' provider function." - (get-text-property (point) 'shr-url)) - -(defun mastodon-mode-hook-fun () - "Function to add to `mastodon-mode-hook'." - (when (and mastodon-use-emojify - (require 'emojify nil :noerror)) - (emojify-mode t) - (when mastodon-toot--enable-custom-instance-emoji - (mastodon-toot-enable-custom-emoji))) - (mastodon-profile--fetch-server-account-settings) - (when (and mastodon-tl--highlight-current-toot - (fboundp #'cursor-face-highlight-mode)) - (cursor-face-highlight-mode)) ; 29.1 - ;; make `thing-at-point' functions work: - (setq-local thing-at-point-provider-alist - (append thing-at-point-provider-alist - '((url . mastodon--url-at-point))))) - -;;;###autoload -(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun) - -(define-derived-mode mastodon-mode special-mode "Mastodon" - "Major mode for fediverse services using the Mastodon API." - (read-only-mode 1)) - -(provide 'mastodon) -;;; mastodon.el ends here diff --git a/elpa/mastodon-20251201.1553/mastodon.info b/elpa/mastodon-20251201.1553/mastodon.info deleted file mode 100644 index ca01e7e8..00000000 --- a/elpa/mastodon-20251201.1553/mastodon.info +++ /dev/null @@ -1,885 +0,0 @@ -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 - - -File: mastodon.info, Node: Top, Next: README, Up: (dir) - -A Mastodon client -***************** - -* Menu: - -* README:: - -— The Detailed Node Listing — - -README - -* Installation:: -* Usage:: -* Dependencies:: -* Network compatibility:: -* Contributing:: -* Supporting ‘mastodon.el’: Supporting mastodonel. -* Contributors:: -* Screenshots:: - -Installation - -* ELPA:: -* MELPA:: -* Repo:: -* Emoji:: -* Discover:: - -Usage - -* Logging in to your instance:: -* Timelines:: -* Composing toots:: -* Other commands and account settings:: -* Notifications:: -* Customization:: -* Commands and variables index:: -* Packages related to ‘mastodon.el’: Packages related to mastodonel. -* Live-updating timelines mastodon-async-mode:: -* Translating toots:: -* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel. - -Contributing - -* Bug reports:: -* Fixes and features:: -* Coding style:: - - - -File: mastodon.info, Node: README, Prev: Top, Up: Top - -1 README -******** - -‘mastodon.el’ is an Emacs client for the ActivityPub social networks -that implement the Mastodon API. For info see joinmastodon.org -(https://joinmastodon.org/). - - NB: ‘mastodon.el’ now ships this readme as an .info file, so if you -have it installed you should be able to browse this readme inside emacs. -‘C-h i’ for info, then ‘m masto RET’ should load it for you. - -* Menu: - -* Installation:: -* Usage:: -* Dependencies:: -* Network compatibility:: -* Contributing:: -* Supporting ‘mastodon.el’: Supporting mastodonel. -* Contributors:: -* Screenshots:: - - -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:: - - -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’ - - -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’ - - -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. - - -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. - - -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)) - - -File: mastodon.info, Node: Usage, Next: Dependencies, Prev: Installation, Up: README - -1.2 Usage -========= - -* Menu: - -* Logging in to your instance:: -* Timelines:: -* Composing toots:: -* Other commands and account settings:: -* Notifications:: -* Customization:: -* Commands and variables index:: -* Packages related to ‘mastodon.el’: Packages related to mastodonel. -* Live-updating timelines mastodon-async-mode:: -* Translating toots:: -* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel. - - -File: mastodon.info, Node: Logging in to your instance, Next: Timelines, Up: Usage - -1.2.1 Logging in to your instance ---------------------------------- - -You need to set 2 variables in your init file to get started: - - 1. ‘mastodon-instance-url’ - 2. ‘mastodon-active-user’ - - (see their doc strings for details). For example If you want to post -toots as "example_user@social.instance.org", then put this in your init -file: - - (setq mastodon-instance-url "https://social.instance.org" - mastodon-active-user "example_user") - - Then *restart* Emacs and run ‘M-x mastodon’. Make sure you are -connected to internet before you do this. If you have multiple mastodon -accounts you can activate one at a time by changing those two variables -and restarting Emacs. - - If you were using mastodon.el before 2FA was implemented and the -above steps do not work, call ‘(mastodon-forget-all-logins)’, restart -Emacs and follow the steps again. - - 1. encrypted access tokens (from 2.0.0) - - By default, user access tokens are now stored in the user’s auth - source file (typically ‘~/.authinfo.gpg’, check the value of - ‘auth-sources’). When you first update to 2.0.0, or if you - encounter issues due to old credentials, call - ‘(mastodon-forget-all-logins)’ to remove the old mastodon.el - plstore, and then authenticate again. If you don’t want to use the - auth source file, set ‘mastodon-auth-use-auth-source’ to nil. - Entries will instead be stored encrypted in - ‘mastodon-client--token-file’, a plstore. - - If for some reason you reauthenticate, you’ll need to either remove - the entry in your auth sources file, or manually update the token - in it after doing so, as mastodon.el is unable to reliably update - (or even remove) entries. - - The format for a mastodon.el auth source entry is as follows: - - ‘machine INSTANCE login USERNAME password AUTHTOKEN’ - - with the token being what you copy from the browser when - authenticating. If you have ‘auth-source-save-behavior’ set to - nil, you’ll also need to add such an entry manually. - - Finally, if you find you’re asked for your key passphrase too often - while authenticating, consider setting ‘epa-file-encrypt-to’ (for - auth-source encryption) and ‘plstore-encrypt-to’ (for plstore - encryption) to your preferred key ID. - - -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/’ Go to the next interesting thing that has an action - ‘M-p/’ Go to the previous interesting thing that has an action - ‘F’ Open federated timeline (1 prefix arg: hide-replies, 2 prefix args: media only) - ‘H’ Open home timeline (1 prefix arg: hide-replies) - ‘L’ Open local timeline (1 prefix arg: hide-replies, 2 prefix args: media only) - ‘N’ Open notifications timeline - ‘@’ Open mentions-only notifications timeline - ‘u’ Update current timeline - ‘T’ Open thread for toot at point - ‘#’ Prompt for tag and open its timeline - ‘A’ Open author profile of toot at point - ‘P’ Open profile of user attached to toot at point - ‘O’ View own profile - ‘U’ update your profile bio note - ‘;’ view instance description for toot at point - ‘:’ view followed tags and load a tag timeline - ‘C-:’ view timeline of all followed tags - ‘,’ view favouriters of toot at point - ‘.’ view boosters of toot at point - ‘/’ switch between mastodon buffers - ‘\’ prompt for an instance domain and view its local timeline (if poss) - ‘Z’ report user/toot at point to instances moderators - *Other views* - ‘s’ search (posts, users, tags) (NB: only posts you have interacted with) - ‘I’, ‘c’, ‘d’ view, create, and delete filters - ‘R’, ‘a’, ‘j’ view/accept/reject follow requests - ‘G’ view follow suggestions - ‘V’ view your favourited toots - ‘K’ view bookmarked toots - ‘X’ view/edit/create/delete lists - ‘S’ view your scheduled toots - ‘S-:’ view profile/account settings transient menu - *Toot actions* - ‘t’ Compose a new toot - ‘c’ Toggle content warning content - ‘b’ Boost toot under ‘point’ - ‘f’ Favourite toot under ‘point’ - ‘k’ toggle bookmark of toot at point - ‘r’ Reply to toot under ‘point’ - ‘v’ Vote on poll at point - ‘C’ copy url of toot at point - ‘C-RET’ play video/gif at point (requires ‘mpv’) - ‘e’ edit your toot at point - ‘E’ view edits of toot at point - ‘i’ (un)pin your toot at point - ‘d’ delete your toot at point, and reload current timeline - ‘D’ delete and redraft toot at point, preserving reply/CW/visibility - ‘!’ toggle folding of toot at point - (‘S-C-’) ‘W’, ‘M’, ‘B’ (un)follow, (un)mute, (un)block author of toot at point - *Profile view* - ‘C-c C-c’ cycle between statuses, statuses without boosts, followers, and following - ‘mastodon-profile--add-account-to-list’ (see lists view) - *Notifications view* - ‘a’, ‘j’ accept/reject follow request - ‘C-k’ clear notification at point - ‘C-c C-c’ cycle between notification types - see ‘mastodon-notifications--get-*’ functions for filtered views - *Quitting* - ‘q’ Quit mastodon buffer, leave window open - ‘Q’ Quit mastodon buffer and kill window - ‘C-M-q’ Quit and kill all mastodon buffers - - 2. Toot byline legend - - Marker Meaning - -------------------------------------------- - ‘(🔁)’ (or I boosted this toot - ‘(B)’) - ‘(⭐)’ (or I favourited this toot - ‘(F)’) - ‘(🔖)’ (or I bookmarked this toot - ‘(K)’) - - -File: mastodon.info, Node: Composing toots, Next: Other commands and account settings, Prev: Timelines, Up: Usage - -1.2.3 Composing toots ---------------------- - -‘M-x mastodon-toot’ (or ‘t’ from a mastodon.el buffer) opens a new -buffer/window in ‘text-mode’ and ‘mastodon-toot’ minor mode. Enter the -contents of your toot here. ‘C-c C-c’ sends the toot. ‘C-c C-k’ -cancels. Both actions kill the buffer and window. Further keybindings -are displayed in the buffer, and in the following subsection. - - Replies preserve visibility status/content warnings, and include -boosters by default. If the region is active when you start a reply, it -will be yanked into the compose buffer prefixed with ‘>’ to form a rough -reply quote. - - Server’s max toot length, with running char count, and attachment -previews, are shown. - - You can download and use your instance’s custom emoji -(‘mastodon-toot--download-custom-emoji’, -‘mastodon-toot--enable-custom-emoji’). - - If you want to view some of the toot being replied to in the compose -buffer, set ‘mastodon-toot-display-orig-in-reply-buffer’ to non-nil. - - The compose buffer uses ‘text-mode’ so any configuration you have for -that mode will be enabled. If any of your existing config conflicts -with ‘mastodon-toot’, you can disable it in the -‘mastodon-toot-mode-hook’. For example, the default value of that hook -is as follows: - - (add-hook 'mastodon-toot-mode-hook - (lambda () - (auto-fill-mode -1))) - - 1. Keybindings - - Key Action - -------------------------------------------- - ‘C-c C-c’ Send toot - ‘C-c C-k’ Cancel toot - ‘C-c C-w’ Add content warning - ‘C-c C-v’ Change toot visibility - ‘C-c C-n’ Add sensitive media/nsfw flag - ‘C-c C-a’ Upload attachment(s) - ‘C-c !’ Remove all attachments - ‘C-c C-e’ Insert emoji - ‘C-c C-p’ Create a poll - ‘C-c C-o’ Cancel poll - ‘C-c C-l’ Set toot language - ‘C-c C-s’ Schedule toot - - 2. Autocompletion of mentions, tags and emoji - - Autocompletion of mentions, tags, and emojis is provided by - ‘completion-at-point-functions’ (capf) backends. - ‘mastodon-toot--enable-completion’ is enabled by default. - - To trigger completion, type a prefix followed by a few letters, ‘@’ - for mentions, ‘#’ for tags, and ‘:’ for emoji (for now this only - works when using ‘emojify.el’). - - If you want to enable ‘company-mode’ in the toot compose buffer, - set ‘mastodon-toot--use-company-for-completion’ to ‘t’. - (‘mastodon.el’ used to run its own native company backends, but - these have been removed in favour of capfs.) - - If you don’t run ‘company’ and want immediate, keyless completion, - you’ll need to have another completion engine running that handles - capfs. A common combination is ‘consult’ and ‘corfu’. - - 3. Draft toots - - • Compose buffer text is saved as you type, kept in - ‘mastodon-toot-current-toot-text’. - • ‘mastodon-toot--save-draft’: save the current toot as a draft. - • ‘mastodon-toot--open-draft-toot’: Open a compose buffer and - insert one of your draft toots. - • ‘mastodon-toot--delete-draft-toot’: Delete a draft toot. - • ‘mastodon-toot--delete-all-drafts’: Delete all your drafts. - - -File: mastodon.info, Node: Other commands and account settings, Next: Notifications, Prev: Composing toots, Up: Usage - -1.2.4 Other commands and account settings: ------------------------------------------- - -In addition to ‘mastodon’, the following three functions are autoloaded -and should work without first loading a ‘mastodon.el’ buffer: - • ‘mastodon-toot’: Compose new toot - • ‘mastodon-notifications-get’: View all notifications - • ‘mastodon-url-lookup’: Attempt to load a URL in ‘mastodon.el’. URL - may be at point or provided in the minibuffer. - - • ‘mastodon-tl--view-instance-description’: View information about - the instance that the author of the toot at point is on. - • ‘mastodon-tl--view-own-instance’: View information about your own - instance. - • ‘mastodon-search--trending-tags’: View a list of trending hashtags - on your instance. - • ‘mastodon-search--trending-statuses’: View a list of trending - statuses on your instance. - • ‘mastodon-search--trending-links’: View a list of trending links on - your instance (+ click through to a timeline of posts featuring a - given link) - - • ‘mastodon-tl--add-toot-account-at-point-to-list’: Add the account - of the toot at point to a list. - - • ‘mastodon-tl--dm-user’: Send a direct message to one of the users - at point. - - • ‘mastodon-profile--add-private-note-to-account’: Add a private note - to another user’s account. - • ‘mastodon-profile--view-account-private-note’: View a private note - on a user’s account. - - • ‘mastodon-profile--show-familiar-followers’: Show a list of - “familiar followers” for a given account. Familiar followers are - accounts that you follow, and that follow the account. - - • ‘mastodon-tl--follow-tag’: Follow a tag (works like following a - user) - • ‘mastodon-tl--unfollow-tag’: Unfollow a tag - • ‘mastodon-tl--list-followed-tags’: View a list of tags you’re - following. - • ‘mastodon-tl--followed-tags-timeline’: View a timeline of all your - followed tags. - • ‘mastodon-tl--some-followed-tags-timleine’: View a timeline of - multiple tags, from your followed tags or any other. - - • ‘mastodon-switch-to-buffer’: switch between mastodon buffers. - - • ‘mastodon-tl--get-remote-local-timeline’: View a local timeline of - a remote instance. - • ‘mastodon-tl--remote-tag-timeline’: View a tag timeline on a remote - instance. - - • ‘mastodon-user-settings’: Launch a transient menu to update various - account settings. - - -File: mastodon.info, Node: Notifications, Next: Customization, Prev: Other commands and account settings, Up: Usage - -1.2.5 Notifications -------------------- - -Mastodon from 4.3 supports grouped notifications. These are implemented -by ‘mastodon.el’ but disabled by default out of consideration to users -on instances that don’t support them. If you are on an instance that -implements grouped notifications, set ‘mastodon-group-notifications’ to -‘t’ to enable them. - - -File: mastodon.info, Node: Customization, Next: Commands and variables index, Prev: Notifications, Up: Usage - -1.2.6 Customization -------------------- - -See ‘M-x customize-group RET mastodon’ to view all customize options. - - • Timeline options: - • Use proportional fonts - • Default number of posts displayed - • Timestamp format - • Relative timestamps - • Display user avatars - • Avatar image height - • Enable image caching - • Hide replies in timelines - • Show toot stats in byline - - • Compose options: - • Completion style for mentions and tags - • Enable custom emoji - • Display toot being replied to - • Set default reply visibility - - • Nofitication options: - • Display user’s profile note in follow requests - • Group notifications - - -File: mastodon.info, Node: Commands and variables index, Next: Packages related to mastodonel, Prev: Customization, Up: Usage - -1.2.7 Commands and variables index ----------------------------------- - -An index of all user-facing commands and custom variables is available -here: mastodon-index.org (mastodon-index.org). - - You can also hit ‘?’ in any ‘mastodon.el’ buffer to see the available -bindings, or run ‘M-X’ (upper-case ‘X’) to view all commands in the -buffer with completion, and call one. - - -File: mastodon.info, Node: Packages related to mastodonel, Next: Live-updating timelines mastodon-async-mode, Prev: Commands and variables index, Up: Usage - -1.2.8 Packages related to ‘mastodon.el’ ---------------------------------------- - - 1. Alternative timeline layout - - The incomparable Nicholas Rougier has written an alternative - timeline layout for ‘mastodon.el’. - - The repo is at mastodon-alt - (https://github.com/rougier/mastodon-alt). - - 2. Org links, archive search - - toot-suite (https://codeberg.org/chrmoe/toot-suite) implements an - org link type for fediverse posts, and also provides a way to - browse an offline archive of your account. - - 3. Mastodon hydra - - A user made a hydra for handling basic ‘mastodon.el’ commands. - It’s available at - . - - 4. Narrow to timeline item - - A simple code snippet to enable narrowing to current item in - timelines: - - - 5. Sachac’s config goodies - - The incomparable sachac has a bunch of ‘mastodon.el’ extensions and - goodies in their literate config, available here: - . - - -File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Packages related to mastodonel, Up: Usage - -1.2.9 Live-updating timelines: ‘mastodon-async-mode’ ----------------------------------------------------- - -(code taken from mastodon-future -(https://github.com/alexjgriffith/mastodon-future.el).) - - Works for federated, local, and home timelines and for notifications. -It’s a little touchy, one thing to avoid is trying to load a timeline -more than once at a time. It can go off the rails a bit, but it’s still -pretty cool. The current maintainer of ‘mastodon.el’ is unable to debug -or improve this feature. - - To enable, it, add ‘(require 'mastodon-async)’ to your ‘init.el’. -Then you can view a timeline with one of the commands that begin with -‘mastodon-async--stream-’. - - -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?")))) - - -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. - - -File: mastodon.info, Node: Dependencies, Next: Network compatibility, Prev: Usage, Up: README - -1.3 Dependencies -================ - -Hard dependencies (should all install with ‘mastodon.el’): - • ‘request’ (for uploading attachments, emacs-request - (https://github.com/tkf/emacs-request)) - • ‘persist’ (for storing some settings across sessions, persist - (https://elpa.gnu.org/packages/persist.html)) - • ‘tp.el’ (for transient menus, tp.el - (https://codeberg.org/martianh/tp.el)) - - Optional dependencies (install yourself, ‘mastodon.el’ can use them): - • ‘emojify’ to use custom emoji (else we use builtin ‘emoji.el’) - • ‘mpv’ and ‘mpv.el’ for viewing videos and gifs - • ‘lingva.el’ for translating toots - - -File: mastodon.info, Node: Network compatibility, Next: Contributing, Prev: Dependencies, Up: README - -1.4 Network compatibility -========================= - -‘mastodon.el’ should work with ActivityPub servers that implement the -Mastodon API. - - Apart from Mastodon itself, it is currently known to work with: - • Pleroma (pleroma.social (https://pleroma.social/)) - • Akkoma (akkoma.social (https://akkoma.social/)) - • Gotosocial (gotosocial.org (https://gotosocial.org/)) - • Sharkey (joinsharkey.org (https://joinsharkey.org)) - - It does not support the non-Mastodon API servers Misskey (misskey.io -(https://misskey.io/)), Firefish (joinfirefish.org -(https://joinfirefish.org/), formerly Calkey) and Friendica, but it -should fully support displaying and interacting with posts and users on -those platforms. - - If you attempt to use ‘mastodon.el’ with a server and run into -problems, feel free to open an issue. - - -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:: - - -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. - - -File: mastodon.info, Node: Fixes and features, Next: Coding style, Prev: Bug reports, Up: Contributing - -1.5.2 Fixes and features ------------------------- - - 1. Install Cask - (https://cask.readthedocs.io/en/latest/guide/installation.html) if - you don’t already have it installed - 2. Create an issue (https://codeberg.org/martianh/mastodon.el/issues) - detailing what you’d like to do. - 3. Fork the repository and create a branch off of ‘develop’. - 4. Run the tests (with ‘make tests’) and ensure that your code doesn’t - break any of them. - 5. Create a pull request (to develop) referencing the issue created in - step 2. - - -File: mastodon.info, Node: Coding style, Prev: Fixes and features, Up: Contributing - -1.5.3 Coding style ------------------- - - • This library uses an unconvential double dash (‘--’) between file - namespaces and function names, which contradicts normal Elisp - style. This needs to be respected until the whole library is - changed. - • Use ‘aggressive-indent-mode’ or similar to keep your code indented. - • Single spaces end sentences in docstrings. - • There’s no need for a blank line after the first docstring line - (one is added automatically when documentation is displayed). - - -File: mastodon.info, Node: Supporting mastodonel, Next: Contributors, Prev: Contributing, Up: README - -1.6 Supporting ‘mastodon.el’ -============================ - -If you’d like to support continued development of ‘mastodon.el’, I -accept donations via paypal: paypal.me/martianh -(https://paypal.me/martianh). - - I also accept support via liberapay: - - If you would prefer a different payment method, please write to me at - 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. - - -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: - - • [original author] - • - • - • - • - - -File: mastodon.info, Node: Screenshots, Prev: Contributors, Up: README - -1.8 Screenshots -=============== - -Here’s a (federated) timeline: - -[image src="screenshot-tl.png"] - - - Here’s a notifcations view plus a compose buffer: - -[image src="screenshot-notifs+compose.png"] - - - Here’s a user settings transient (active values green, current server -values commented and, if a boolean, underlined): - -[image src="screenshot-transient-1.jpg"] - - - Here’s a user profile fields transient (changed fields green, current -server values commented): - -[image src="screenshot-transient-2.jpg"] - - - - -Tag Table: -Node: Top219 -Node: README1083 -Node: Installation1732 -Node: ELPA2021 -Node: MELPA2249 -Node: Repo2629 -Node: Emoji3122 -Node: Discover3716 -Node: Usage4268 -Node: Logging in to your instance4770 -Ref: encrypted access tokens (from 200)5742 -Node: Timelines7200 -Ref: Keybindings7675 -Ref: Toot byline legend12657 -Node: Composing toots12966 -Ref: Keybindings (1)14518 -Ref: Autocompletion of mentions tags and emoji15073 -Ref: Draft toots15998 -Node: Other commands and account settings16469 -Node: Notifications19144 -Node: Customization19629 -Node: Commands and variables index20517 -Node: Packages related to mastodonel21036 -Ref: Alternative timeline layout21289 -Ref: Org links archive search21516 -Ref: Mastodon hydra21735 -Ref: Narrow to timeline item21919 -Ref: Sachac's config goodies22126 -Node: Live-updating timelines mastodon-async-mode22345 -Node: Translating toots23200 -Node: Bookmarks and mastodonel24383 -Node: Dependencies24925 -Node: Network compatibility25711 -Node: Contributing26652 -Node: Bug reports27148 -Node: Fixes and features28059 -Node: Coding style28722 -Node: Supporting mastodonel29346 -Node: Contributors29947 -Node: Screenshots30382 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/elpa/mastodon-20260406.856/README-elpa b/elpa/mastodon-20260406.856/README-elpa new file mode 100644 index 00000000..2e50bcf0 --- /dev/null +++ b/elpa/mastodon-20260406.856/README-elpa @@ -0,0 +1,5 @@ +mastodon.el is a client for fediverse services that implement the Mastodon +API. See . + +For set up and usage details, see the Info documentation, or the readme +file at . diff --git a/elpa/mastodon-20260406.856/dir b/elpa/mastodon-20260406.856/dir new file mode 100644 index 00000000..28d21f79 --- /dev/null +++ b/elpa/mastodon-20260406.856/dir @@ -0,0 +1,19 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + + This (the Directory node) gives a menu of major topics. + Typing "q" exits, "H" lists all Info commands, "d" returns here, + "h" gives a primer for first-timers, + "mEmacs" 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. diff --git a/elpa/mastodon-20260406.856/mastodon-async.el b/elpa/mastodon-20260406.856/mastodon-async.el new file mode 100644 index 00000000..b059407d --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-async.el @@ -0,0 +1,362 @@ +;;; mastodon-async.el --- Async streaming functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Alex J. Griffith +;; Author: Alex J. Griffith +;; Maintainer: Marty Hiatt +;; 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 . + +;;; 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 diff --git a/elpa/mastodon-20260406.856/mastodon-auth.el b/elpa/mastodon-20260406.856/mastodon-auth.el new file mode 100644 index 00000000..2902c319 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-auth.el @@ -0,0 +1,321 @@ +;;; mastodon-auth.el --- Auth functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2021 Abhiseck Paira +;; Copyright (C) 2025 Marty Hiatt +;; Author: Johnson Denen +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-auth.el supports authorizing and authenticating with Mastodon. + +;;; Code: + +(require 'plstore) +(require 'auth-source) +(require 'json) +(require 'url) + +(eval-when-compile (require 'subr-x)) ; for if-let* + +(autoload 'mastodon-client "mastodon-client") +(autoload 'mastodon-client--active-user "mastodon-client") +(autoload 'mastodon-client--form-user-from-vars "mastodon-client") +(autoload 'mastodon-client--make-user-active "mastodon-client") +(autoload 'mastodon-client--store-access-token "mastodon-client") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--concat-params-to-url "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-return-credential-account "mastodon") +(autoload 'mastodon-client--general-read "mastodon-client") +(autoload 'mastodon-client--token-file "mastodon-client") + +(defvar mastodon-instance-url) +(defvar mastodon-client-scopes) +(defvar mastodon-client-redirect-uri) +(defvar mastodon-active-user) + +(defgroup mastodon-auth nil + "Authenticate with Mastodon." + :prefix "mastodon-auth-" + :group 'mastodon) + +(defcustom mastodon-auth-use-auth-source t + "Whether to use auth sources for user credentials. +If t, save and read user access token in the user's auth source +file (see `auth-sources'). If nil, use `mastodon-client--token-file' +instead. +If you change the value of this variable, call +`mastodon-forget-all-logins' and log in again. +If for some reason you generate a new token, you'll have to update your +auth souce file manually, or at least remove the entry and authenticate +again, as auth-source.el only provides unreliable tools for updating +entries." + :type 'boolean) + +(defvar mastodon-auth-source-file nil + "This variable is obsolete. +This variable currently serves no purpose and will be removed in +the future.") + +(defvar mastodon-auth--token-alist nil + "Alist of User access tokens keyed by instance url.") + +(defvar mastodon-auth--acct-alist nil + "Alist of account accts (name@domain) keyed by instance url.") + +(defvar mastodon-auth--user-unaware + " ** MASTODON.EL - NOTICE ** + +User variables not set: mastodon.el requires that you set both +`mastodon-active-user' and `mastodon-instance-url' in your init file. + +Please see its documentation to understand what value it accepts +by running M-x describe-variable on it or visiting our web page: +https://codeberg.org/martianh/mastodon.el. +") + +(defun mastodon-auth--get-browser-login-url () + "Return properly formed browser login url." + (let ((client-id (plist-get (mastodon-client) :client_id))) + (if (not client-id) + (error "Failed to set up client id") + (mastodon-http--concat-params-to-url + (concat mastodon-instance-url "/oauth/authorize/") + `(("response_type" . "code") + ("redirect_uri" . ,mastodon-client-redirect-uri) + ("scope" . ,mastodon-client-scopes) + ("client_id" . ,client-id)))))) + +(defvar mastodon-auth--explanation + (format + " +1. A URL has been copied to your clipboard. Open this URL in a +javascript capable browser and your browser will take you to your +Mastodon instance's login page. + +2. Login to your account (%s) and authorize \"mastodon.el\". + +3. After authorization you will be presented an authorization +code. Copy this code and paste it in the minibuffer prompt." + (mastodon-client--form-user-from-vars))) + +(defun mastodon-auth--show-notice (notice buffer-name &optional ask) + "Display NOTICE to user. +By default NOTICE is displayed in vertical split occupying 50% of total +width. The buffer name of the buffer being displayed in the +window is BUFFER-NAME. +When optional argument ASK is given which should be a string, use +ASK as the minibuffer prompt. Return whatever user types in +response to the prompt. +When ASK is absent return nil." + (let ((buffer (get-buffer-create buffer-name)) + (inhibit-read-only t) + ask-value window) + (set-buffer buffer) + (erase-buffer) + (insert notice) + (fill-region (point-min) (point-max)) + (read-only-mode) + + (setq window (select-window + (split-window (frame-root-window) nil 'below) + t)) + (switch-to-buffer buffer t) + (when ask + (setq ask-value (read-string ask)) + (kill-buffer buffer) + (delete-window window)) + ask-value)) + +(defun mastodon-auth--request-authorization-code () + "Ask authorization code and return it." + (let ((url (mastodon-auth--get-browser-login-url)) + (select-enable-clipboard t) + authorization-code) + (kill-new url) + (message "%s" url) + (setq authorization-code + (mastodon-auth--show-notice mastodon-auth--explanation + "*mastodon-notice*" + "Authorization Code: ")) + authorization-code)) + +(defun mastodon-auth--generate-token () + "Generate access_token for the user. Return response buffer." + (let ((authorization-code (mastodon-auth--request-authorization-code))) + (mastodon-http--post + (concat mastodon-instance-url "/oauth/token") + `(("grant_type" . "authorization_code") + ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) + ("client_id" . ,(plist-get (mastodon-client) :client_id)) + ("code" . ,authorization-code) + ("redirect_uri" . ,mastodon-client-redirect-uri)) + nil + :unauthenticated))) + +(defun mastodon-auth--get-token () + "Make a request to generate an auth token and return JSON response." + (with-current-buffer (mastodon-auth--generate-token) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-object-type 'plist) + (json-key-type 'keyword) + (json-array-type 'vector) + (json-string (buffer-substring-no-properties (point) (point-max)))) + (json-read-from-string json-string)))) + +(defun mastodon-auth--plstore-token-check (&optional auth-source) + "Signal an error if plstore contains unencrypted access-token. +If AUTH-SOURCE, and if `mastodon-auth-use-auth-source' is non-nil, +return non-nil if it contains any access token. +Used to help users switch to the new encrypted auth token flow." + ;; FIXME: is it poss to move this plstore read to have one less read? + ;; e.g. inside of `mastodon-client--active-user'? the issue is that + ;; ideally we want to test "user-" entry, even if fetching "active-user" + ;; entry, so we would have to re-do the plstore read functions. + (when + (mastodon-auth--plstore-access-token-member auth-source) + (if auth-source + (user-error "Auth source storage of tokens is enabled,\ + but there is also an access token in your plstore.\ + If you're seeing this message after updating,\ + call `mastodon-forget-all-logins', and try again. + If you don't want to use auth sources,\ + also set `mastodon-auth-use-auth-source' to nil.\ + If this message is in error, contact us on the mastodon.el repo") + (user-error "Unencrypted access token in your plstore.\ + If you're seeing this message after updating,\ + call `mastodon-forget-all-logins', and log in again. + If this message is in error, contact us on the mastodon.el repo")))) + +(defun mastodon-auth--plstore-access-token-member (&optional auth-source) + "Return non-nil if the user entry of the plstore contains :access_token. +If AUTH-SOURCE, also check if it contains :secret-access_token." + (let* ((plstore (plstore-open (mastodon-client--token-file))) + (name (concat "user-" (mastodon-client--form-user-from-vars))) + ;; get alist like plstore.el does, so that keys will display with + ;; ":secret-" prefix if encrypted: + (alist (assoc name (plstore--get-merged-alist plstore)))) + (if (and auth-source mastodon-auth-use-auth-source) + (or (member :access_token alist) + (member :secret-access_token alist)) + (member :access_token alist)))) + +(defun mastodon-auth--access-token () + "Return the access token to use with `mastodon-instance-url'. +Generate/save token if none known yet." + (cond + (mastodon-auth--token-alist + ;; user variables are known and initialised. + (alist-get mastodon-instance-url + mastodon-auth--token-alist nil nil #'string=)) + ;; if auth source enabled, but we have an access token in plstore, + ;; error out and tell user to remove plstore and start over or disable + ;; auth source: + ((mastodon-auth--plstore-token-check)) + ((plist-get (mastodon-client--active-user) :access_token) + ;; user variables need to be read from plstore active-user entry. + (push (cons mastodon-instance-url + (plist-get (mastodon-client--active-user) :access_token)) + mastodon-auth--token-alist) + (alist-get mastodon-instance-url + mastodon-auth--token-alist nil nil #'string=)) + ((null mastodon-active-user) + ;; user not aware of 2FA-related changes and has not set + ;; `mastodon-active-user'. Make user aware and error out. + (mastodon-auth--show-notice mastodon-auth--user-unaware + "*mastodon-notice*") + (user-error "Variables not set properly")) + (t + ;; user access-token needs to fetched from the server and + ;; stored and variables initialised. + (mastodon-auth--handle-token-response (mastodon-auth--get-token))))) + +(defun mastodon-auth--handle-token-response (response) + "Add token RESPONSE to `mastodon-auth--token-alist'. +The token is returned by `mastodon-auth--get-token'. +Handle any errors from the server." + (pcase response + ((and (let token (plist-get response :access_token)) + (guard token)) + (mastodon-client--make-user-active + (mastodon-client--store-access-token token)) + (cdar (push (cons mastodon-instance-url token) + mastodon-auth--token-alist))) + (`(:error ,class :error_description ,error) + (error "Mastodon-auth--access-token: %s: %s" class error)) + (_ (error "Unknown response from mastodon-auth--get-token!")))) + +(defun mastodon-auth-source-get (user host &optional token create) + "Fetch an auth source token, searching by USER and HOST. +If CREATE, use TOKEN or prompt for it, and save it if there is no such entry. +Return a list of user, password/secret, and the item's save-function." + (let* ((auth-source-creation-prompts + '((secret . "%u access token: "))) + (source + (car + (auth-source-search :host host :user user + :require '(:user :secret) + :secret (if token token nil) + ;; "create" alone doesn't work here!: + :create (if create t nil))))) + (when source + (let ((creds + `(,(plist-get source :user) + ,(auth-info-password source) + ,(plist-get source :save-function)))) + (when create ;; call save function: + (when (functionp (nth 2 creds)) + (funcall (nth 2 creds)))) + creds)))) + +(defun mastodon-auth-source-token (url handle &optional token create) + "Parse URL, search auth sources with it, user HANDLE and TOKEN. +Calls `mastodon-auth-source-get', returns only the token. +If CREATE, create an entry is none is found." + (let ((host (url-host + (url-generic-parse-url url))) + (username (car (split-string handle "@")))) + (nth 1 + (mastodon-auth-source-get username host token create)))) + +(defun mastodon-auth--get-account-name () + "Request user credentials and return an account name." + (alist-get 'acct + (mastodon-return-credential-account))) + +(defun mastodon-auth--get-account-id () + "Request user credentials and return an account name." + (alist-get 'id + (mastodon-return-credential-account))) + +(defun mastodon-auth--user-acct () + "Return a mastodon user acct name." + (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist)) + (let ((acct (mastodon-auth--get-account-name))) + (push (cons mastodon-instance-url acct) mastodon-auth--acct-alist) + acct))) + +(provide 'mastodon-auth) +;;; mastodon-auth.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-autoloads.el b/elpa/mastodon-20260406.856/mastodon-autoloads.el new file mode 100644 index 00000000..f005e35b --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-autoloads.el @@ -0,0 +1,166 @@ +;;; 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))) + + + +;;; Generated autoloads from mastodon.el + +(autoload 'mastodon-forget-all-logins "mastodon" +"Delete `mastodon-client--token-file'. +Also nil `mastodon-auth--token-alist'." t) +(autoload 'mastodon "mastodon" +"Connect client to `mastodon-instance-url' instance. +If there are any open mastodon.el buffers, switch to one instead. +Prority in switching is given to timeline views." t) +(autoload 'mastodon-toot "mastodon" +"Update instance with new toot. Content is captured in a new buffer. +If USER is non-nil, insert after @ symbol to begin new toot. +If REPLY-TO-ID is non-nil, attach new toot to a conversation. +If REPLY-JSON is the json of the toot being replied to. +QUOTE-ID is the id of a toot being quoted, QUOTE-JSON is its data. +VISIBILITY is the visibility of the toot. + +(fn &optional USER REPLY-TO-ID REPLY-JSON QUOTE-ID QUOTE-JSON VISIBILITY)" t) +(autoload 'mastodon-notifications-get "mastodon" +"Display NOTIFICATIONS in buffer. +Optionally only print notifications of type TYPE, a string. +BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. +MAX-ID is a request parameter for pagination. + +(fn &optional TYPE BUFFER-NAME MAX-ID)" t) +(autoload 'mastodon-notifications-check "mastodon" +"Check for the number of unread notifications." t) +(autoload 'mastodon-url-lookup "mastodon" +"If a URL resembles a fediverse link, try to load in `mastodon.el'. +Does a WebFinger lookup on the server. +URL can be arg QUERY-URL, or URL at point, or provided by the user. +If a status or account is found, load it in `mastodon.el', if +not, just browse the URL in the normal fashion. +If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'. + +(fn &optional QUERY-URL FORCE)" t) +(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun) +(register-definition-prefixes "mastodon" '("mastodon-")) + + +;;; 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--")) + + +;;; Generated autoloads from mastodon-auth.el + +(register-definition-prefixes "mastodon-auth" '("mastodon-auth-")) + + +;;; Generated autoloads from mastodon-client.el + +(register-definition-prefixes "mastodon-client" '("mastodon-client")) + + +;;; Generated autoloads from mastodon-discover.el + +(register-definition-prefixes "mastodon-discover" '("mastodon-discover")) + + +;;; Generated autoloads from mastodon-http.el + +(register-definition-prefixes "mastodon-http" '("mastodon-http--")) + + +;;; Generated autoloads from mastodon-inspect.el + +(register-definition-prefixes "mastodon-inspect" '("mastodon-inspect--")) + + +;;; Generated autoloads from mastodon-iso.el + +(register-definition-prefixes "mastodon-iso" '("mastodon-iso-639-")) + + +;;; Generated autoloads from mastodon-media.el + +(register-definition-prefixes "mastodon-media" '("mastodon-media--")) + + +;;; Generated autoloads from mastodon-notifications.el + +(register-definition-prefixes "mastodon-notifications" '("mastodon-")) + + +;;; Generated autoloads from mastodon-profile.el + +(register-definition-prefixes "mastodon-profile" '("mastodon-profile")) + + +;;; Generated autoloads from mastodon-search.el + +(register-definition-prefixes "mastodon-search" '("mastodon-search-")) + + +;;; Generated autoloads from mastodon-tl.el + +(register-definition-prefixes "mastodon-tl" '("mastodon-" "with-mastodon-buffer")) + + +;;; 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")) + + +;;; Generated autoloads from mastodon-transient.el + +(register-definition-prefixes "mastodon-transient" '("mastodon-")) + + +;;; Generated autoloads from mastodon-views.el + +(autoload 'mastodon-views-view-scheduled-toots "mastodon-views" +"Show the user's scheduled toots in a new buffer." t) +(autoload 'mastodon-views-view-filters "mastodon-views" +"View the user's filters in a new buffer." t) +(register-definition-prefixes "mastodon-views" '("mastodon-views-")) + + +;;; Generated autoloads from mastodon-widget.el + +(register-definition-prefixes "mastodon-widget" '("mastodon-widget-")) + +;;; 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 diff --git a/elpa/mastodon-20260406.856/mastodon-client.el b/elpa/mastodon-20260406.856/mastodon-client.el new file mode 100644 index 00000000..1ad6d2be --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-client.el @@ -0,0 +1,262 @@ +;;; mastodon-client.el --- Client functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2021 Abhiseck Paira +;; Copyright (C) 2025 Marty Hiatt +;; Author: Johnson Denen +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-client.el supports registering the Emacs client with your Mastodon instance. + +;;; Code: + +(require 'plstore) +(require 'json) +(require 'url) + +(defvar mastodon-instance-url) +(defvar mastodon-active-user) +(defvar mastodon-auth-use-auth-source) + +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-auth-source-token "mastodon-auth") + +(defcustom mastodon-client--token-file + (concat user-emacs-directory "mastodon.plstore") + "File path where Mastodon access tokens are stored." + :group 'mastodon + :type 'file) + +(defvar mastodon-client--client-details-alist nil + "An alist of Client id and secrets keyed by the instance url.") + +(defvar mastodon-client--active-user-details-plist nil + "A plist of active user details.") + +(defvar mastodon-client-scopes "read write follow" + "Scopes to pass to oauth during registration.") + +(defvar mastodon-client-website "https://codeberg.org/martianh/mastodon.el" + "Website of mastodon.el.") + +(defvar mastodon-client-redirect-uri "urn:ietf:wg:oauth:2.0:oob" + "Redirect_uri as required by oauth.") + +(defun mastodon-client--register () + "POST client to Mastodon." + (mastodon-http--post (mastodon-http--api "apps") + `(("client_name" . "mastodon.el") + ("redirect_uris" . ,mastodon-client-redirect-uri) + ("scopes" . ,mastodon-client-scopes) + ("website" . ,mastodon-client-website)) + nil + :unauthenticated)) + +(defun mastodon-client--fetch () + "Return JSON from `mastodon-client--register' call." + (let ((buf (mastodon-client--register))) + (if (not buf) + (user-error "Client registration failed.\ + Is `mastodon-instance-url' correct?") + (with-current-buffer buf + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let* ((json-object-type 'plist) + (json-key-type 'keyword) + (json-array-type 'vector) + (json-string + (buffer-substring-no-properties (point) (point-max))) + (parsed + (json-read-from-string json-string))) + (if (eq :error (car parsed)) + (error "Error: %s" (cadr parsed)) + parsed)))))) + +(defun mastodon-client--token-file () + "Return `mastodon-client--token-file'." + mastodon-client--token-file) + +(defun mastodon-client--store () + "Store client_id and client_secret in `mastodon-client--token-file'. +Make `mastodon-client--fetch' call to determine client values. +Return a plist of secret and non-secret key/val pairs." + (let* ((plstore (plstore-open (mastodon-client--token-file))) + (client (mastodon-client--fetch)) + (secrets `( :client_id ,(plist-get client :client_id) + :client_secret ,(plist-get client :client_secret))) + (sans-secrets + (dolist (x '(:client_id :client_secret) client) + (cl-remf client x))) + ;; alexgriffith reported seeing ellipses in the saved output + ;; which indicate some output truncating. Nothing in + ;; `plstore-save' seems to ensure this cannot happen so let's do + ;; that ourselves: + (print-length nil) + (print-level nil)) + (plstore-put plstore + (concat "mastodon-" mastodon-instance-url) + sans-secrets secrets) + ;; FIXME: breaks tests: prompts for gpg passphrase + (plstore-save plstore) + (plstore-close plstore) + (append secrets sans-secrets))) + +(defun mastodon-client--remove-key-from-plstore (plstore) + "Remove KEY from PLSTORE." + (cdr plstore)) + +;; Actually it returns a plist with client-details if such details are +;; already stored in mastodon.plstore +(defun mastodon-client--read () + "Retrieve client_id and client_secret from `mastodon-client--token-file'." + (let* ((plstore (plstore-open (mastodon-client--token-file))) + (mastodon + (plstore-get plstore + (concat "mastodon-" mastodon-instance-url)))) + (plstore-close plstore) + (mastodon-client--remove-key-from-plstore mastodon))) + +(defun mastodon-client--general-read (key) + "Retrieve the plstore item keyed by KEY. +Return plist without the KEY." + (let* ((plstore (plstore-open (mastodon-client--token-file))) + (plstore-item (plstore-get plstore key))) + (plstore-close plstore) + (mastodon-client--remove-key-from-plstore plstore-item))) + +(defun mastodon-client--make-user-details-plist () + "Make a plist with current user details. Return it." + `( :username ,(mastodon-client--form-user-from-vars) + :instance ,mastodon-instance-url + :client_id ,(plist-get (mastodon-client) :client_id) + :client_secret ,(plist-get (mastodon-client) :client_secret))) + +(defun mastodon-client--store-access-token (token) + "Save TOKEN as :access_token encrypted in the plstore. +Return the plist after the operation. +If `mastodon-auth-use-auth-source', encrypt it in auth source file." + (let* ((user-details (mastodon-client--make-user-details-plist)) + (plstore (plstore-open (mastodon-client--token-file))) + (username (mastodon-client--form-user-from-vars)) + (key (concat "user-" username)) + (secrets `( :client_id ,(plist-get user-details :client_id) + :client_secret ,(plist-get user-details :client_secret))) + (sans-secrets + (dolist (x '(:client_id :client_secret) user-details) + (cl-remf user-details x))) + (print-length nil) + (print-level nil)) + (if mastodon-auth-use-auth-source + ;; auth-source: + (progn + (mastodon-auth-source-token + mastodon-instance-url username token :create) + (plstore-put plstore key sans-secrets secrets)) + ;; plstore encrypted: + (plstore-put plstore key sans-secrets + (append secrets `(:access_token ,token)))) + (plstore-save plstore) + (plstore-close plstore) + (cdr (plstore-get plstore key)))) + +(defun mastodon-client--make-user-active (user-details) + "USER-DETAILS is a plist consisting of user details. +Save it to plstore under key \"active-user\". +If `mastodon-auth-use-auth-source' is non-nil, fetch the access token +from the user's auth source file and add it to the active user entry. +Return a plist of secret and non-secret key/val pairs." + (let* ((plstore (plstore-open (mastodon-client--token-file))) + (handle (plist-get user-details :username)) + (token + (if mastodon-auth-use-auth-source + (mastodon-auth-source-token mastodon-instance-url handle) + (plist-get user-details :access_token))) + (secrets `( :access_token ,token + :client_id ,(plist-get user-details :client_id) + :client_secret ,(plist-get user-details :client_secret))) + (deets (copy-sequence user-details)) + (sans-secrets + (dolist (x '(:client_id :client_secret :access_token) deets) + (cl-remf deets x))) + (print-length nil) + (print-level nil)) + (plstore-put plstore "active-user" sans-secrets secrets) + (plstore-save plstore) + (plstore-close plstore) + (append secrets sans-secrets))) + +(defun mastodon-client--form-user-from-vars () + "Create a username from user variable. Return that username. +Username in the form user@instance.com is formed from the +variables `mastodon-instance-url' and `mastodon-active-user'." + (concat mastodon-active-user + "@" + (url-host (url-generic-parse-url mastodon-instance-url)))) + +(defun mastodon-client--make-current-user-active () + "Make the user specified by user variables active user. +Return the details (plist)." + (let* ((username (mastodon-client--form-user-from-vars)) + (user-plist (mastodon-client--general-read + (concat "user-" username)))) + (when user-plist + (mastodon-client--make-user-active user-plist) + user-plist))) + +(defun mastodon-client--current-user-active-p () + "Return user-details if the current user is active. +Otherwise return nil." + (let ((username (mastodon-client--form-user-from-vars)) + (user-details (mastodon-client--general-read "active-user"))) + (when (and user-details + (string= (plist-get user-details :username) username)) + user-details))) + +(defun mastodon-client--active-user () + "Return the details of the currently active user. +Details is a plist." + (or mastodon-client--active-user-details-plist + (setq mastodon-client--active-user-details-plist + (or (mastodon-client--current-user-active-p) + (mastodon-client--make-current-user-active))))) + +(defun mastodon-client () + "Return variable client secrets to use for `mastodon-instance-url'. +If `mastodon-client--client-details-alist' is nil, read plist from +`mastodon-client--token-file'. +Fetch and store plist if `mastodon-client--read' returns nil. +Return a plist." + (let ((client-details + (cdr (assoc mastodon-instance-url + mastodon-client--client-details-alist)))) + (or client-details + (let ((client-details (or (mastodon-client--read) + (mastodon-client--store)))) + (push (cons mastodon-instance-url client-details) + mastodon-client--client-details-alist) + client-details)))) + +(provide 'mastodon-client) +;;; mastodon-client.el ends here + diff --git a/elpa/mastodon-20260406.856/mastodon-discover.el b/elpa/mastodon-20260406.856/mastodon-discover.el new file mode 100644 index 00000000..81dc3937 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-discover.el @@ -0,0 +1,125 @@ +;;; 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 +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; This adds optional functionality that can be used if the dicover package +;; is present. +;; +;; See the README file for how to use this. + +;;; Code: + +(declare-function discover-add-context-menu "discover") + +(autoload 'mastodon-kill-window "mastodon") + +(defun mastodon-discover () + "Plug Mastodon functionality into `discover'." + (interactive) + (when (require 'discover nil :noerror) + (discover-add-context-menu + :bind "?" + :mode 'mastodon-mode + :mode-hook 'mastodon-mode-hook + :context-menu + '(mastodon + (description "Mastodon feed viewer") + (actions + ("Toots" + ("A" "View profile of author" mastodon-profile-get-toot-author) + ("b" "Boost" mastodon-toot--boost) + ("f" "Favourite" mastodon-toot--favourite) + ("c" "Toggle hidden text (CW)" mastodon-tl-toggle-spoiler-text-in-toot) + ("k" "Bookmark toot" mastodon-toot-toggle-bookmark) + ("v" "Vote on poll" mastodon-tl-poll-vote) + ("n" "Next" mastodon-tl-goto-next-item) + ("p" "Prev" mastodon-tl-goto-prev-item) + ("TAB" "Next link item" mastodon-tl-next-tab-item) + ("S-TAB" "Prev link item" mastodon-tl-previous-tab-item) + ;; NB: (when (require 'mpv etc. calls don't work here + ("C-RET" "Play media" mastodon-tl-mpv-play-video-at-point) + ("t" "New toot" mastodon-toot) + ("r" "Reply" mastodon-toot-reply) + ("C" "Copy toot URL" mastodon-toot-copy-toot-url) + ("o" "Open toot URL" mastodon-toot-browse-toot-url) + ("d" "Delete (your) toot" mastodon-toot-delete-toot) + ("D" "Delete and redraft (your) toot" mastodon-toot-delete-toot) + ("e" "Edit (your) toot" mastodon-toot-edit-toot-at-point) + ("E" "View edits of (your) toot" mastodon-toot-view-toot-edits) + ("i" "Pin/Unpin (your) toot" mastodon-toot-pin-toot-toggle) + ("P" "View user profile" mastodon-profile-show-user) + ("a" "Translate toot at point" mastodon-toot-translate-toot-text) + ("T" "View thread" mastodon-tl-thread) + ("v" "Vote on poll" mastodon-tl-poll-vote) + ("," "View toot's favouriters" mastodon-toot--list-toot-favouriters) + ("." "View toot's boosters" mastodon-toot--list-toot-boosters) + ("/" "Switch buffers" mastodon-switch-to-buffer)) + ("Views" + ("h/?" "View mode help/keybindings" describe-mode) + ("#" "Tag search" mastodon-tl-get-tag-timeline) + ("\"" "List followed tags" mastodon-tl-list-followed-tags) + ("'" "Followed tags timeline" mastodon-tl-followed-tags-timeline) + ("F" "Federated" mastodon-tl-get-federated-timeline) + ("H" "Home" mastodon-tl-get-home-timeline) + ("L" "Local" mastodon-tl-get-local-timeline) + ("N" "Notifications" mastodon-notifications-get) + ("@" "Notifications with mentions" mastodon-notifications-get-mentions) + ("g/u" "Update timeline" mastodon-tl-update) + ("s" "Search" mastodon-search-query) + ("O" "Jump to your profile" mastodon-profile-my-profile) + ("U" "Update your profile note" mastodon-profile-update-user-profile-note) + ("K" "View bookmarks" mastodon-profile-view-bookmarks) + ("V" "View favourites" mastodon-profile-view-favourites) + ("R" "View follow requests" mastodon-profile--view-follow-requests) + ("G" "View follow suggestions" mastodon-tl--get-follow-suggestions) + ("I" "View filters" mastodon-tl--view-filters) + ("X" "View lists" mastodon-tl--view-lists) + ("S" "View scheduled toots" mastodon-tl--view-scheduled-toots) + (";" "View instance description" mastodon-tl--view-instance-description)) + ("Users" + ("W" "Follow" mastodon-tl-follow-user) + ("C-S-W" "Unfollow" mastodon-tl-unfollow-user) + ("M" "Mute" mastodon-tl-mute-user) + ("C-S-M" "Unmute" mastodon-tl-unmute-user) + ("B" "Block" mastodon-tl-block-user) + ("C-S-B" "Unblock" mastodon-tl-unblock-user)) + ("Images" + ;; RET errors here also :/ + ("/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 diff --git a/elpa/mastodon-20260406.856/mastodon-http.el b/elpa/mastodon-20260406.856/mastodon-http.el new file mode 100644 index 00000000..16c9d787 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-http.el @@ -0,0 +1,441 @@ +;;; 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 +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-http.el provides HTTP request/response functions. + +;;; Code: + +(require 'json) +(require 'url) +(require 'url-http) +(require 'shr) + +(defvar mastodon-instance-url) +(defvar mastodon-toot--media-attachment-ids) +(defvar mastodon-toot--media-attachment-filenames) + +(autoload 'mastodon-auth--access-token "mastodon-auth") +(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'url-insert "url-handlers") + +(defvar mastodon-http--api-version "v1") + +(defconst mastodon-http--timeout 15 + "HTTP request timeout, in seconds. Has no effect on Emacs < 26.1.") + +(defun mastodon-http--api (endpoint &optional version) + "Return Mastodon API URL for ENDPOINT. +Optionally specify VERSION in format vX." + (concat mastodon-instance-url "/api/" + (or version mastodon-http--api-version) "/" endpoint)) + +(defun mastodon-http--api-v2 (endpoint) + "Return Mastodon API v2 URL for ENDPOINT." + (mastodon-http--api endpoint "v2")) + +(defun mastodon-http--url-retrieve-synchronously (url &optional silent) + "Retrieve URL asynchronously. +This is a thin abstraction over the system +`url-retrieve-synchronously'. Depending on which version of this +is available we will call it with or without a timeout. +SILENT means don't message." + (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) + (url-retrieve-synchronously url) + (url-retrieve-synchronously url (or silent nil) nil mastodon-http--timeout))) + +(defun mastodon-http--response-status (resp) + "Return the status code from RESP, a response buffer." + ;; `url-http-parse-response' breaks tests, as + ;; `url-http-end-of-headers' not set, so we roll our own: + (with-current-buffer resp + (goto-char (point-min)) + (skip-chars-forward " \t\n") ; Skip any blank crap + (skip-chars-forward "/HPT0-9.") ; Skip HTTP Version "HTTP/X.Y" + (read (current-buffer)))) + +(defun mastodon-http--triage (response success) + "Determine if RESPONSE was successful. +Call SUCCESS on RESPONSE if successful. Message status and JSON error +from RESPONSE if unsuccessful." + (let ((status (mastodon-http--response-status response))) + (if (and (>= 200 status) + (<= status 299)) + ;; (string-prefix-p "2" (number-to-string status)) + (funcall success response) + (if (= 404 status) + (message "Error %s: page not found" status) + (let ((json-response (with-current-buffer response + (mastodon-http--process-json)))) + (message "Error %s: %s" status (alist-get 'error json-response))))))) + +(defun mastodon-http--read-file-as-string (filename &optional url) + "Read a file FILENAME as a string. +Used to generate image preview. +URL means FILENAME is a URL." + (with-temp-buffer + (if url + (url-insert-file-contents filename) + (insert-file-contents filename)) + (string-to-unibyte (buffer-string)))) + +(defmacro mastodon-http--authorized-request (method body &optional unauthenticated-p) + "Make a METHOD type request using BODY, with Mastodon authorization. +Unless UNAUTHENTICATED-P is non-nil." + (declare (debug 'body) + (indent 1)) + `(let ((url-request-method ,method) + (url-request-extra-headers + (unless ,unauthenticated-p + (list (cons "Authorization" + (concat "Bearer " (mastodon-auth--access-token))))))) + ,body)) + +(defun mastodon-http--build-params-string (params) + "Build a request parameters string from parameters alist PARAMS." + ;; (url-build-query-string args nil)) + ;; url-build-query-string adds 'nil' for empty params so lets stick with our + ;; own: + (mapconcat (lambda (p) + (when (cdr p) ; only when value + (concat (url-hexify-string (car p)) + "=" (url-hexify-string (cdr p))))) + params "&")) + +(defun mastodon-http--build-array-params-alist (param-str array) + "Return parameters alist using PARAM-STR and ARRAY param values. +Used for API form data parameters that take an array." + (cl-loop for x in array + collect (cons param-str x))) + +(defun mastodon-http--concat-params-to-url (url params) + "Build a query string with PARAMS and concat to URL." + (if params + (concat url "?" + (mastodon-http--build-params-string params)) + url)) + +(defun mastodon-http--post (url + &optional params headers unauthenticated-p json) + "POST synchronously to URL, optionally with PARAMS and HEADERS. +Authorization header is included by default unless +UNAUTHENTICATED-P is non-nil. +If JSON is :json, encode PARAMS as JSON for +the request data. If it is :raw, just use the plain params." + ;; NB: raw is used by `mastodon-tl-unfilter-user-languages'; not sure if + ;; there's a way around it? + (mastodon-http--authorized-request "POST" + (let* ((url-request-data + (when params + (cond ((eq json :json) + (json-encode params)) + ((eq json :raw) + params) + (t + (mastodon-http--build-params-string params))))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + (if json + '(("Content-Type" . "application/json") + ("Accept" . "application/json")) + (unless (assoc "Content-Type" headers) ; pleroma compat: + '(("Content-Type" . "application/x-www-form-urlencoded")))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))) + unauthenticated-p)) + +(defun mastodon-http--get (url &optional params silent) + "Make synchronous GET request to URL. +PARAMS is an alist of any extra parameters to send with the request. +SILENT means don't message." + (mastodon-http--authorized-request "GET" + ;; url-request-data doesn't seem to work with GET requests?: + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--url-retrieve-synchronously url silent)))) + +(defun mastodon-http--get-response (url &optional params no-headers silent vector) + "Make synchronous GET request to URL. Return JSON and response headers. +PARAMS is an alist of any extra parameters to send with the request. +SILENT means don't message. +NO-HEADERS means don't collect http response headers. +VECTOR means return json arrays as vectors." + (let ((buf (mastodon-http--get url params silent))) + ;; --get can return nil if instance unresponsive: + (if (not buf) + (user-error "Looks like the server response borked. \ +Is your instance up?") + (with-current-buffer buf + (mastodon-http--process-response no-headers vector))))) + +(defun mastodon-http--get-json (url &optional params silent vector) + "Return only JSON data from URL request. +PARAMS is an alist of any extra parameters to send with the request. +SILENT means don't message. +VECTOR means return json arrays as vectors." + (car (mastodon-http--get-response url params :no-headers silent vector))) + +(defun mastodon-http--process-json () + "Return only JSON data from async URL request. +Callback to `mastodon-http--get-json-async', usually +`mastodon-tl--init*', is run on the result." + (car (mastodon-http--process-response :no-headers))) + +(defun mastodon-http--render-html-err (string) + "Render STRING as HTML in a temp buffer. +STRING should be a HTML for a 404 errror." + (with-temp-buffer + (insert string) + (shr-render-buffer (current-buffer)) + (view-mode))) ; for 'q' to kill buffer and window + ;; (error ""))) ; stop subsequent processing + +(defun mastodon-http--process-response (&optional no-headers vector) + "Process http response. +Return a cons of JSON list and http response headers. +If NO-HEADERS is non-nil, just return the JSON. +VECTOR means return json arrays as vectors. +Callback to `mastodon-http--get-response-async', usually +`mastodon-tl--init*', is run on the result." + ;; view raw response: + ;; (switch-to-buffer (current-buffer)) + (let ((headers (unless no-headers + (mastodon-http--process-headers)))) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-array-type (if vector 'vector 'list)) + (json-string (string-trim-right + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8)))) + (kill-buffer) + (cond ((or (string-empty-p json-string) (null json-string)) + nil) + ;; if we get html, just render it and error: + ;; ideally we should handle the status code in here rather than + ;; this crappy hack? + ((string-prefix-p "\n<" json-string) ; html hack + ;; NB: in this case, process-response returns t!: + (mastodon-http--render-html-err json-string) + nil) ;; return nil instead of t + ;; if no json or html, maybe we have a plain string error message + ;; (misskey does this, but there are probably better ways to do + ;; this): + ((not (or (string-prefix-p "\n{" json-string) + (string-prefix-p "\n[" json-string))) + (error "%s" json-string)) + (t + ;; instance may return error in JSON e.g. ((error . "Record not + ;; found")) for a null endpoint. but we don't error here because + ;; sometimes we just want to check for such an error in an + ;; if/cond. + `(,(json-read-from-string json-string) . ,headers)))))) + +(defun mastodon-http--process-headers () + "Return an alist of http response headers." + (goto-char (point-min)) + (let* ((head-str (buffer-substring-no-properties + (point-min) + (re-search-forward "^$" nil 'move))) + (head-list (split-string head-str "\n"))) + (mapcar (lambda (x) + (let ((list (split-string x ": "))) + (cons (car list) (cadr list)))) + head-list))) + +(defun mastodon-http--delete (url &optional params) + "Make DELETE request to URL. +PARAMS is an alist of any extra parameters to send with the request." + ;; url-request-data only works with POST requests? + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--authorized-request "DELETE" + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) + +(defun mastodon-http--put (url &optional params headers) + "Make PUT request to URL. +PARAMS is an alist of any extra parameters to send with the request. +HEADERS is an alist of any extra headers to send with the request." + (mastodon-http--authorized-request "PUT" + (let ((url-request-data + (when params (mastodon-http--build-params-string params))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + (unless (assoc "Content-Type" headers) ; pleroma compat: + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) + +;; profile update functions + +(defun mastodon-http--patch-json (url &optional params) + "Make synchronous PATCH request to URL. Return JSON response. +Optionally specify the PARAMS to send." + (with-current-buffer (mastodon-http--patch url params) + (mastodon-http--process-json))) + +(defun mastodon-http--patch (url &optional params json) + "Make synchronous PATCH request to URL. +Optionally specify the PARAMS to send. +JSON means send params as JSON data." + (mastodon-http--authorized-request "PATCH" + ;; NB: unlike POST, PATCHing only works if we use query params! + ;; so here, unless JSON arg, we use query params and do not set + ;; `url-request-data'. this is probably an error, i don't understand it. + (let* ((url-request-data + (when (and params json) + (encode-coding-string + (json-encode params) 'utf-8))) + ;; (mastodon-http--build-params-string params)))) + (url (if (not json) + (mastodon-http--concat-params-to-url url params) + url)) + (headers (when json + '(("Content-Type" . "application/json") + ("Accept" . "application/json")))) + (url-request-extra-headers + (append url-request-extra-headers headers))) + (mastodon-http--url-retrieve-synchronously url)))) + + ;; Asynchronous functions + +(defun mastodon-http--get-async (url &optional params silent + callback &rest cbargs) + "Make GET request to URL. +Pass response buffer to CALLBACK function with args CBARGS. +PARAMS is an alist of any extra parameters to send with the request. +Optionally make the request SILENT." + (let ((url (mastodon-http--concat-params-to-url url params))) + (mastodon-http--authorized-request "GET" + (url-retrieve url callback cbargs silent)))) + +(defun mastodon-http--get-response-async (url &optional params silent + callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with http response and CBARGS. +PARAMS is an alist of any extra parameters to send with the request. +Optionally make the request SILENT." + (mastodon-http--get-async + url + params silent + (lambda (status) + (when status ; for flakey servers + (apply callback (mastodon-http--process-response) cbargs))))) + +(defun mastodon-http--get-json-async (url &optional params silent + callback &rest cbargs) + "Make GET request to URL. Call CALLBACK with json-list and CBARGS. +PARAMS is an alist of any extra parameters to send with the request. +Optionally make the request SILENT." + (mastodon-http--get-async + url + params silent + (lambda (status) + (when status ;; only when we actually get sth? + (apply callback (mastodon-http--process-json) cbargs))))) + +(defun mastodon-http--post-async (url params _headers &optional callback &rest cbargs) + "POST asynchronously to URL with PARAMS and HEADERS. +Then run function CALLBACK with arguements CBARGS. +Authorization header is included by default unless UNAUTHENTICED-P is non-nil." + (mastodon-http--authorized-request "POST" + (let ((url-request-data (when params + (mastodon-http--build-params-string params)))) + (with-temp-buffer + (url-retrieve url callback cbargs))))) + +(defun mastodon-http--get-cb-data (status) + "Return data using `json-read' after a successful async request. +If STATUS includes an error, emit a message describing it and return nil." + (let* ((buf (current-buffer)) + (data (with-temp-buffer + (url-insert buf) + (goto-char (point-min)) + (json-read)))) + (if-let* ((error-thrown (plist-get status :error))) + ;; not necessarily a user error, but we want its functionality: + (user-error "%S %s" error-thrown (alist-get 'error data)) + data))) + +(defun mastodon-http--post-media-callback (status file caption buffer) + "Callback function called after posting FILE as an attachment with CAPTION. +The toot is being composed in BUFFER. See `url-retrieve' for STATUS." + (unwind-protect + (when-let* ((data (mastodon-http--get-cb-data status))) + (with-current-buffer buffer + (let ((id (alist-get 'id data))) + ;; update ids: + (if (not mastodon-toot--media-attachment-ids) + ;; add first id: + (push id mastodon-toot--media-attachment-ids) + ;; add new id to end of list to preserve order: + (push id (cdr + (last mastodon-toot--media-attachment-ids)))) + ;; pleroma, PUT the description: + ;; this is how the mangane akkoma web client does it + ;; and it seems easier than the other options! + (when (and caption + (not (string= caption (alist-get 'description data)))) + (let ((url (mastodon-http--api (format "media/%s" id)))) + ;; (message "PUTting image description") + (mastodon-http--put url `(("description" . ,caption))))) + (message "Uploading %s... (done)" file) + (mastodon-toot--update-status-fields)))) + (kill-buffer (current-buffer)))) + +(defun mastodon-http--post-media-prep-file (filename) + "Return the request data to upload FILENAME." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally filename) + (let ((boundary (buffer-hash))) + (goto-char (point-min)) + (insert "--" boundary "\r\n" + (format "Content-Disposition: form-data; name=\"file\"; filename=\"%s\"\r\n\r\n" + (file-name-nondirectory filename))) + (goto-char (point-max)) + (insert "\r\n" "--" boundary "--" "\r\n") + `(,boundary . ,(buffer-substring-no-properties (point-min) (point-max)))))) + +(defun mastodon-http--post-media-attachment (url filename caption) + "Make POST request to upload FILENAME with CAPTION to the server's media URL. +The upload is asynchronous. On succeeding, +`mastodon-toot--media-attachment-ids' is set to the id(s) of the +item uploaded, and `mastodon-toot--update-status-fields' is run." + (mastodon-http--authorized-request "POST" + (let* ((data (mastodon-http--post-media-prep-file filename)) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + `(("Content-Type" . ,(format "multipart/form-data; boundary=%s" + (car data)))))) + (url-request-data (cdr data)) + (params `(("description" . ,caption))) + (url (mastodon-http--concat-params-to-url url params))) + (url-retrieve url #'mastodon-http--post-media-callback + `(,filename ,caption ,(current-buffer)))))) + +(provide 'mastodon-http) +;;; mastodon-http.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-inspect.el b/elpa/mastodon-20260406.856/mastodon-inspect.el new file mode 100644 index 00000000..77959898 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-inspect.el @@ -0,0 +1,129 @@ +;;; mastodon-inspect.el --- Client for Mastodon -*- lexical-binding: t -*- + +;; Copyright (C) 2017-2019 Johnson Denen +;; Copyright (C) 2020-2024 Marty Hiatt +;; Author: Johnson Denen +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; Some tools to help inspect / debug mastodon.el + +;;; Code: +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-search-json "mastodon-http") +(autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") +(autoload 'mastodon-tl--toot "mastodon-tl") + +(defvar mastodon-instance-url) + +(defgroup mastodon-inspect nil + "Tools to help inspect toots." + :prefix "mastodon-inspect-" + :group 'external) + +(defun mastodon-inspect--dump-json-in-buffer (name json) + "Buffer NAME is opened and JSON in printed into it." + (switch-to-buffer-other-window name) + (erase-buffer) + (let ((print-level nil) + (print-length nil)) + (pp json (current-buffer)) + (goto-char (point-min)) + (emacs-lisp-mode) + (message "success"))) + +(defun mastodon-inspect--toot () + "Find next toot and dump its meta data into new buffer." + (interactive) + (mastodon-inspect--dump-json-in-buffer + (concat "*mastodon-inspect-toot-" + (mastodon-tl--as-string (mastodon-tl--property 'item-id)) + "*") + (mastodon-tl--property 'item-json))) + +(defun mastodon-inspect--download-single-toot (item-id) + "Download the toot/status represented by ITEM-ID." + (mastodon-http--get-json + (mastodon-http--api (concat "statuses/" item-id)))) + +(defun mastodon-inspect--view-single-toot (item-id) + "View the toot/status represented by ITEM-ID." + (interactive "s Toot ID: ") + (let ((buffer (get-buffer-create (concat "*mastodon-status-" item-id "*")))) + (with-current-buffer buffer + (let ((toot (mastodon-inspect--download-single-toot item-id ))) + (mastodon-tl--toot toot) + (goto-char (point-min)) + (while (search-forward "\n\n\n | " nil t) + (replace-match "\n | ")) + (mastodon-media--inline-images (point-min) (point-max)))) + (switch-to-buffer-other-window buffer) + (mastodon-mode))) + +(defun mastodon-inspect--view-single-toot-source (item-id) + "View the ess source of a toot/status represented by ITEM-ID." + (interactive "s Toot ID: ") + (mastodon-inspect--dump-json-in-buffer + (concat "*mastodon-status-raw-" item-id "*") + (mastodon-inspect--download-single-toot item-id))) + + +(defvar mastodon-inspect--search-query-accounts-result) +(defvar mastodon-inspect--single-account-json) + +(defvar mastodon-inspect--search-query-full-result) +(defvar mastodon-inspect--search-result-tags) + +(defun mastodon-inspect--get-search-result (query) + "Inspect function for a search result for QUERY." + (interactive) + (setq mastodon-inspect--search-query-full-result + (append ; convert vector to list + (mastodon-http--get-search-json + (format "%s/api/v2/search" mastodon-instance-url) + query) + nil)) + (setq mastodon-inspect--search-result-tags + (append (cdr + (caddr mastodon-inspect--search-query-full-result)) + nil))) + +(defun mastodon-inspect--get-search-account (query) + "Return JSON for a single account after search QUERY." + (interactive) + (setq mastodon-inspect--search-query-accounts-result + (append ; convert vector to list + (mastodon-http--get-search-json + (format "%s/api/v1/accounts/search" mastodon-instance-url) + query) + nil)) + (setq mastodon-inspect--single-account-json + (car mastodon-inspect--search-query-accounts-result))) + + +(provide 'mastodon-inspect) +;;; mastodon-inspect.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-iso.el b/elpa/mastodon-20260406.856/mastodon-iso.el new file mode 100644 index 00000000..6199cbe0 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-iso.el @@ -0,0 +1,244 @@ +;;; mastodon-iso.el --- ISO language code lists for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Marty Hiatt +;; Author: Marty Hiatt +;; 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 . + +;;; 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 diff --git a/elpa/mastodon-20260406.856/mastodon-media.el b/elpa/mastodon-20260406.856/mastodon-media.el new file mode 100644 index 00000000..0e3c24a2 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-media.el @@ -0,0 +1,534 @@ +;;; 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 +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-media.el provides functions for inlining media. + +;; Known bug gnutls -12 when trying to access images on some systems. +;; It looks like their may be a version mismatch between the encryption +;; required by the server and client. + +;;; Code: +(require 'url-cache) +(require 'mm-decode) +(require 'image-mode) + +(autoload 'mastodon-tl--propertize-img-str-or-url "mastodon-tl") +(autoload 'mastodon-tl--image-trans-check "mastodon-tl") +(autoload 'mastodon-image-mode "mastodon-tl") + +(defvar url-show-status) + +(defvar mastodon-tl--shr-image-map-replacement) + +(defgroup mastodon-media nil + "Inline Mastadon media." + :prefix "mastodon-media-" + :group 'mastodon) + +(defcustom mastodon-media--avatar-height 20 + "Height of the user avatar images (if shown)." + :type 'integer) + +(defcustom mastodon-media--preview-max-height 250 + "Max height of any media attachment preview to be shown in timelines." + :type 'integer) + +(defcustom mastodon-media--enable-image-caching nil + "Whether images should be cached." + :type 'boolean) + +(defcustom mastodon-media--hide-sensitive-media t + "Whether media marked as sensitive should be hidden." + :type 'boolean) + +(defvar mastodon-media--generic-avatar-data + (base64-decode-string + "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA +B3RJTUUH4QUIFCg2lVD1hwAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAcGSURB +VHja7dzdT1J/HAfwcw7EQzMKW0pGRMK4qdRZbdrs6aIRbt506V1b/AV1U2td9l9UXnmhW6vgwuko +SbcOD/a0RB4CCRCRg0AIR4Hz8LvgN2cKCMI5wOH7uXBuugO+eH8+fM/3HIFpmoZAVVYIIABYAAtg +ASyABbAAAcACWAALYAEsgAUIABbAAlgAC2ABLEAAsAAWwAJYAAtgAQKAxUjxm+R50DRN0zRFUf+8 +kggCwzAMwwDrfyOSJGmattlsdrvd5XLlcrndnyoUir6+vpGRkZMnT/J4vIarwY26MaTAZLVap6en +fT7f9vY2QRA7Ozv/vJJ8vkgk4vP5XV1dWq1Wq9VKpdIGkjUGi6IoFEWnp6ddLlcymSRJsvzv83g8 +kUikUCi0Wq1Opzt16lS7YBEE8ebNG6PRiGHYoUwHyW7cuPHo0SOlUsl9LIIgXrx4Ybfb//79e7Qj +CIXC3t7ex48fX7lyhctYBSkURTOZTC3H4fF4SqXy6dOnLHuxh0VR1PPnz2uX2uv17Nmzy5cvc21R +StP0q1ev7HZ7XaQgCCJJ0u/3T0xMBINBrmGhKGo0Go88p0p5Wa1Wg8GQSqW4g0XT9NTUFIZhdT9y +Npudn59nLVwIO7FyuVxVrRIqr1AoZDab2QkXG1hTU1PJZJKhg5MkOT8/HwqFuIBF07TP52MoVrvh +YqLHG4BlsVi2t7cZfQiSJB0OBwudyDiWzWYjCILpR1lZWeECltPp3LeXwEQFg8FoNNryWPl8noVp +ws6jgG1lgAWwuI914cIFPp/xnX6ZTCYSiVoeq7+/n4U/Q61Wy+Xylse6desWC8kaGBiQSCQtjyWR +SGQyGY/HY+4hpFJpV1cXRwa8TqdjtBOHh4fVajVHsLRarVKpZChcUqn07t27LPQgS1gSiUSn04nF +4rofGYbh4eHhgYEBTq2ztFrtyMhI3ZtRo9GMjY2xEyv2sCQSiV6vV6lUdWzGzs7O8fHxwcFBDq7g +5XL5kydPent76+LV2dmp1+vv37/P5gqe7SvSDofj5cuXteydwjAslUr1ev2DBw9YPt1pwL0ODodj +YmLCYrEcYZ8LhmGNRjM+Ps5yphqGBUFQKBQyGo0mk2l1dTWfz5MkSVFUPp8/+GSEQiEMw8eOHYNh +uLu7e2hoaGxsjM05tbfYvpkNx/FQKBSJRCAI6unpwTBsbW0tmUwWbtc6mCMEQSAIOn78+Llz586f +P9/T05PL5QKBgEKh4GyyCkZfvnwJhULhcHhzczOTyRRuYMtms/l8PpPJZDKZnZ2dvc9HIBCIxeIT +J04Uvil87ejoOH36tEwm02g0V69evXjxIkewCkZer/fr16+/f/+OxWKlrvQQBEEQxL7dYQRBhEJh +0fNwBEHEYrFMJlOpVP39/RqNhgU1prAKTDMzMy6XKxqNJhIJptY+CHLmzBmZTHbp0qXbt2+rVKpW +wtplWl5eDofDTF803Bs0tVrNKFmdsXAcn52dnZ2dDQaD7DAVJRsdHb1z507dT93rhoXj+MrKytzc +3NLSEnNNVyHZ2bNnr127NjQ0NDg4WEey+mDhOP7u3bu5ubkyI5z9iMnl8nv37o2OjgoEgmbBisVi +r1+/ttlsjQ1UmYg9fPiwo6OjwVg4jn///v3Dhw/Ly8vNEKiiXhKJpK+vT6fT1d6S/FqkUBSdnJz0 ++/1QsxZFUclkEkXReDxOkuT169dr8TpisnAcN5lMb9++ZfP+11pKIBAUdgpv3rx55BGGtIMUBEG5 +XM7tdhsMhoWFhb3/S8UsVitK1curaqzV1dX379+3nNQ+r42NjSPsPlaH5fP5mnyiV+Ll9XonJyfD +4XC1XkhVDTgzM/Pz50+oxSubzX779u3z58/VLneQyqUMBsOnT5+acz1V7XoiHo9//PjRZDKl0+n6 +Y3k8HrPZ3Gxr9Fq81tfXl5aWAoFA5cO+IqxIJFLYSIA4VARBuN3uxcXFyoc9v5IGNJvNVquVAw14 +sBktFkt3d7dUKq3k5BGpJFYLCwucacCizZhIJCoJF3JorBYXF//8+QNxtAiCKFwiqKRvkEPnOoqi +HGvAfeFKJBIVTnqkfKx+/PjBsbleKlwej6cmLI/H43A4OByr3XClUimn03louMphra2teb1eqA0q +m836fL6tra0jYkUiEb/fz8k3waLhikQiXq+3/NtiSayNjY1fv35BbVP5fN7pdG5tbR0Fy+12c360 +Hxzz5a8KI6V6EMMwzo/2fZ2YTqej0WgqlSoVLqRUDwYCAajNiqKoYDBYphOLY8ViscItVG1VJEmu +r6+XeU8sjhWPxzc3N9sNiyAIDMOqS1YbDqwKx1YRrFQqxc7HJDRnpdPpUuEqgoVhWL0+i6hFz6tL +ja3iM4u1zw1qwhlfJihI0bfCNhxYe4NSqg3/A862hQAbrdtHAAAAAElFTkSuQmCC") + "The PNG data for a generic 100x100 avatar.") + +(defvar mastodon-media--generic-broken-image-data + (base64-decode-string + "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA +B3RJTUUH4QUIFQUVFt+0LQAAABZ0RVh0Q29tbWVudABHZW5lcmljIGF2YXRhcsyCnMsAAAdoSURB +VHja7d1NSFRrAIfx//iB6ZDSMJYVkWEk0ceYFUkkhhQlEUhEg0FlC1eBoRTUwlbRok0TgRQURZAE +FgpjJmFajpK4kggxpXHRQEGWUJZizpy7uPfC5eKiV+dD5zw/mN05jrxnnjnfcxyWZVkCMKc0SXI4 +HIwEMIcUhgAgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCAAgQAEAhAIQCAAgQA2kBaNP8Jt7ViM +onErOWsQgEAAAgEIBCAQgEAAAgEIBCAQgEAAEAhAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAA +AgEIBCAQgEAAAgEIBACBAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgECAxSyNIYitz58/ +a3BwUIODgxoZGVEoFFIoFNK3b980NTWlX79+SZIyMzOVlZWlVatWae3atSooKJDH49HOnTvl8XiU +ksJ3WSI4LMuyHA7Hgv6IZVmM5D8mJyf1/PlzdXZ2qrOzU8FgcMF/0+126+DBg6qqqlJFRYXS0vhe ++6MP9wI/1wQSJeFwWH6/X01NTWpra9PU1FTM3isvL0/nz5/XuXPntHz5ciqIcSCy/v50L+hlV+Pj +49a1a9esdevWLXgMTV8ul8u6c+eOFYlELMwtKmNNIOa+fv1qXbp0yXI6nXEP4/+v0tJS6+PHj9RA +IIk3PT1tXb161crOzk54GP995ebmWt3d3RRBIInj9/utgoKCRRXGf18ZGRmW3++niigHwk56PHf4 +Yiw9PV0dHR0qLy9nD52jWAQylxUrVmhgYEAbN24kkCgsM84+JZmJiQmdPn1akUiEweBE4eL/NsrN +zVVZWZlKSkpUWFioTZs2yeVyKTs7W7Ozs5qYmNDExITev3+v/v5+9fX1qb+/f8FjevPmTdXW1rIG +IZDFN9gbNmyQ1+uV1+uVx+MxXlAjIyNqbGzU3bt39fPnz3n9vytXrlQwGJTT6SQQThQm/ohIamqq +VVlZaXV1dUXtPT98+GCVlZXNe7n4fD6OYnGYN7GDnZ6ebtXU1FhjY2Mxed9IJGLV19fPa7kUFRUR +CIEkZrAdDod15syZmIXxf7W1tfNaNqOjowSygBdHseZh7969GhgY0IMHD5Sfnx+X97xx44Z2795t +PF93dzcLjMO88TvHcP/+ffX19WnXrl3xXVApKbp9+7bxfSFv3rxhwRFI7B07dkxDQ0Oqrq5O2P9Q +XFysffv2Gc0zOjrKwiOQ2Hv69Kny8vIS/n8cP37caPqxsTEWHoHYa//HxPfv3xk0ArGP1atXG03/ +7z3vIBBbyM3NNZo+KyuLQSMQ+5icnDSaPicnh0EjEPsYHh42mp7L3gnEVnp6eoymLyoqYtAIxD4e +PXpkNP3+/fsZtAXgcvclpL29XUeOHPnj6Z1Op8bHx7Vs2TJ7fri5o9A+ZmZmdPHiRaN5vF6vbeNg +E8tmGhoaNDQ0ZPTteeHCBQaOQJLfkydPdP36daN5Tp48qc2bNzN47IMkt9evX+vw4cOanp7+43ly +cnI0PDy8KK4dYx8EMRMIBHT06FGjOCTJ5/PZPg42sZJce3u7Dh06pB8/fhjNV11dndBL8tnEYhMr +5lpaWuT1evX792+j+YqLixUIBLj+ik2s5NXc3KwTJ04Yx5Gfn69nz54RB5tYyaupqUlVVVWanZ01 +ms/tdqujo4P9DgJJXg8fPtSpU6cUDoeN43j58qUKCwsZRAJJTvfu3dPZs2eNf0/X7Xarq6tL27dv +ZxAJJDn5fD7V1NQYx7FmzRq9evVK27ZtYxAJJDk1NDSorq7O+ChgQUGBent7tWXLFgYxxniecILU +1dXJ5/MZz7d161a9ePHC+N50sAZZMq5cuTKvOEpKStTT00McccSJwji7devWvJ7bceDAAbW2ttr6 +cQbGH26eD7K0BAIBlZeXG5/nqKioUEtLizIyMhhEAklOX758kcfj0adPn4zXHG1tbcSRoEDYB4mT +y5cvG8exZ88etba2Egf7IMnt7du32rFjh9G5jvz8fA0MDBj/UBxYgyw5jY2NRnGkpqaqubmZOBYB +AomxmZkZPX782Gie+vr6uD9/BGxiJURvb69KS0v/ePrMzEyFQiG5XC4Gj02s5BcIBIymr6ysJA42 +sezj3bt3RtObPv8DBLKkBYNBo+m5r4NAbCUUChlNv379egaNQOzD9FdJ2P8gEFsxfQQaFyMuLhzm +jfUAG45tOBw2fhY6ojP2rEGWwiqdONjEAggEIBCAQAACAUAgAIEA0cIPx8UYJ1FZgwAEAhAIAAIB +CAQgEIBAAAIBFiNOFMaY6V1tnFhkDQIQCEAgAIEABAKAQAACAQgEIBCAQAACAQgEIBCAQABIXO4e +c1y+zhoEIBCAQAAQCEAgAIEABAIQCEAgAIEABAIQCEAgAAgEIBCAQAACAQgEIBCAQAACAQgEAIEA +BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA +fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") + "The PNG data for a generic 200x200 \"broken image\" view.") + +(defvar mastodon-media--sensitive-image-data + (base64-decode-string + "iVBORw0KGgoAAAANSUhEUgAAAMgAAADICAYAAACtWK6eAAAA6npUWHRSYXcgcHJvZmlsZSB0eXBl +IGV4aWYAAHjajVHbjcQwCPx3FVcCr/hRjvOSroMtfyc2Ts4rrXRIxjAQPEzC8fo9w89lkiXYknIs +MRLMihWpCDJ1W5tnsuabbaPGMx7uggBS3NrTIo4fwBGz58X7efSPQSPgimh5CrU6vs746gMlfw5y +Bsr9Zdr9Ax+k4oxsXi2WnKbV9o1my88xTRKXyMngTSilWBBnIUvQc7+InpuUNmjpgt7AyEergJMc +ykrwqtZZ6nVMK+7YvAU0skMMb9qFJ/xKUADz4g9VusX8q82j0Rf7z1rhDfqGdxgpcULlAAABhWlD +Q1BJQ0MgcHJvZmlsZQAAeJx9kT1Iw0AcxV8/tKJVBzuIOGSoTnZREd1qFYpQIdQKrTqYXPohNGlI +UlwcBdeCgx+LVQcXZ10dXAVB8APE2cFJ0UVK/F9SaBHjwXE/3t173L0D/PUyU81gHFA1y0gnE0I2 +tyKEXtGJIHowgz6JmfqsKKbgOb7u4ePrXYxneZ/7c/QqeZMBPoE4znTDIl4nntq0dM77xBFWkhTi +c+Ixgy5I/Mh12eU3zkWH/TwzYmTSc8QRYqHYxnIbs5KhEk8SRxVVo3x/1mWF8xZntVxlzXvyF4bz +2vIS12kOI4kFLEKEABlVbKAMCzFaNVJMpGk/4eEfcvwiuWRybYCRYx4VqJAcP/gf/O7WLEyMu0nh +BNDxYtsfI0BoF2jUbPv72LYbJ0DgGbjSWv5KHZj+JL3W0qJHQP82cHHd0uQ94HIHGHzSJUNypABN +f6EAvJ/RN+WAgVuge9XtrbmP0wcgQ12lboCDQ2C0SNlrHu/uau/t3zPN/n4Ag31yra/8+kkAAA14 +aVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8P3hwYWNrZXQgYmVnaW49Iu+7vyIgaWQ9Ilc1TTBN +cENlaGlIenJlU3pOVGN6a2M5ZCI/Pgo8eDp4bXBtZXRhIHhtbG5zOng9ImFkb2JlOm5zOm1ldGEv +IiB4OnhtcHRrPSJYTVAgQ29yZSA0LjQuMC1FeGl2MiI+CiA8cmRmOlJERiB4bWxuczpyZGY9Imh0 +dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogIDxyZGY6RGVzY3Jp +cHRpb24gcmRmOmFib3V0PSIiCiAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94 +YXAvMS4wL21tLyIKICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv +c1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2Vs +ZW1lbnRzLzEuMS8iCiAgICB4bWxuczpHSU1QPSJodHRwOi8vd3d3LmdpbXAub3JnL3htcC8iCiAg +ICB4bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht +cD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgeG1wTU06RG9jdW1lbnRJRD0iZ2lt +cDpkb2NpZDpnaW1wOmYyYjU4MzUwLTc3ZWMtNDAxNC1hNDVlLTE1N2QyZjljOGM5NyIKICAgeG1w +TU06SW5zdGFuY2VJRD0ieG1wLmlpZDowOTk5MzZhMi1jOGM5LTRkYTAtYTI0Yi02YTM1MmUyNmNi +NmUiCiAgIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDphMDliYmZhMi03MzA2LTQ3 +NWQtOGExNC05YzA3ZTE1NmFiMTYiCiAgIGRjOkZvcm1hdD0iaW1hZ2UvcG5nIgogICBHSU1QOkFQ +ST0iMi4wIgogICBHSU1QOlBsYXRmb3JtPSJMaW51eCIKICAgR0lNUDpUaW1lU3RhbXA9IjE3MTc1 +MDI1MDIzNDQ1NzIiCiAgIEdJTVA6VmVyc2lvbj0iMi4xMC4zNCIKICAgdGlmZjpPcmllbnRhdGlv +bj0iMSIKICAgeG1wOkNyZWF0b3JUb29sPSJHSU1QIDIuMTAiCiAgIHhtcDpNZXRhZGF0YURhdGU9 +IjIwMjQ6MDY6MDRUMTQ6MDE6NDArMDI6MDAiCiAgIHhtcDpNb2RpZnlEYXRlPSIyMDI0OjA2OjA0 +VDE0OjAxOjQwKzAyOjAwIj4KICAgPHhtcE1NOkhpc3Rvcnk+CiAgICA8cmRmOlNlcT4KICAgICA8 +cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0ic2F2ZWQiCiAgICAgIHN0RXZ0OmNoYW5nZWQ9Ii8i +CiAgICAgIHN0RXZ0Omluc3RhbmNlSUQ9InhtcC5paWQ6NTRmM2I5NDktOTlkMS00Mzk2LWI2NzIt +Y2ZkYjRlZWFiYTA1IgogICAgICBzdEV2dDpzb2Z0d2FyZUFnZW50PSJHaW1wIDIuMTAgKExpbnV4 +KSIKICAgICAgc3RFdnQ6d2hlbj0iMjAyNC0wNi0wNFQxNDowMTo0MiswMjowMCIvPgogICAgPC9y +ZGY6U2VxPgogICA8L3htcE1NOkhpc3Rvcnk+CiAgPC9yZGY6RGVzY3JpcHRpb24+CiA8L3JkZjpS +REY+CjwveDp4bXBtZXRhPgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg +ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAg +ICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6w3d0DAAAABmJLR0QA/wD/AP+gvaeTAAAA +CXBIWXMAAC4jAAAuIwF4pT92AAAAB3RJTUUH6AYEDAEq/VtQSwAAABl0RVh0Q29tbWVudABDcmVh +dGVkIHdpdGggR0lNUFeBDhcAAAtOSURBVHja7dvbT5R3Hsfxz5xwhtOsjkgFGQZRTlFOCjJSkpVe +YFltmpZNuo3t9qLdu/4Pa/+L3jVZL9pEU2q7aGirEkUkWw+IM5SpOELxgICcUXjmsBfKBOooo2Za +3H2/Ei+EeRif74/3c5gnmj47fDgqAHGZGQFAIACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEI +BCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAhAIACBAAQCgEAAAgEIBCAQgEAAAgEIBCAQgEAAAgFA +IACBAAQCEAhAIACBAAQCEAhAIAAIBCAQgEAAAgEIBCAQgEAAAgEIBCAQAAQCEAhAIACBAAQCEAjw +CrIm+w0ikYiCwaB8Pp8GBweVk5OjoqIiOZ1OjY+Pq6qq6g8fwuLiov7d1qbFhQUdOHhQaampSd0O +BBLT2dmp8+fP6/3331dzc7Oi0ahu3bql1tZW7dixY00MIRqNKhQKyWyxyPQ7bAcCkSSNjY3p7Nmz +anzjDeXl5cW+7vF41NLSos7OzjUxhHXr1umvLS2/23bgHkSSNDk5+ahC65Md5uTkaMuyaID/u0BS +UlIkSd0XLmhubu6J73vr6tb8gO7fv69gMMhvyhqfV7LeN6mBZGdnKysrS1NTU2r95htNTU29Uou9 +uLiojo4OhUIhfvPX8LyS+b6mzw4fjibzHz8+Pq6jx45pfGxMqamp+suBA9pWWCiTKf5tbSgU0vXr +1+X3+3Xnzh1t2bJFFRUV8ng8kqSBgQF99dVXkiTXxo36xyefaGBgQD6/X0ODg8rNzVVdXZ1ycnJW +DNDn86nv55/1YH5excXF8nq9slgsikajmpiY0PDwsPx+v5qbm5WZmamJiQmdOHlSN4NB2Ww2paWn +a252Vk1NTSovL3/qdsePH1dfX5/WrVsnm82mSCSiAwcOqKCgQF1dXeru7pbNZpNhGCoqKlJzc3NC ++53oJW0gEND1gQGNjY4qNzdXZWVlKikpic07EolocHBQgUBAwWBQVqtVnoICFW3frry8vNjrnnfO +q80rWeub6Pu+KMu+ffv+mcxAUlNTVVxUpLm5Od2+fVt+n0/z8/PavHlz7BJsiWEYOnXqlDwej6qr +q1VVVaUHDx+qtbVVm7KztdHlktPp1I4dOxQIBDQ5OSmTySSXy6Vd1dWqrKxU8OZNnTl9Wrt27Yrd ++5w5c0YOh0NvNDYqPz9f7e3tqq6ultVq1YMHD+T3+3X+/HmNjIyourpaDodDDodDmzZt0uXLl/XO +O+9o//79qq+vV3Z2tiQ9dbvCwkLl5ubqypUrcjqd+vjjj+VyuSRJW7ZsUVlZmX755Rft3r1bDQ0N +MpvNCe33avoDAXV0dKi2pkY1u3erpLRU83Nz8vv9Ki4ultVq1eLiotrb2zU8PKz6+nrt3btXZWVl +j87wra0yDENut1tms/m557zavJK1vom875q9xFqSkZGhgwcP6t1335XdbtelS5f0xRdf6N69eyte +19PTo/T0dL322muyWCxKSUlRdVWVcnJzdaKtTXNzc7JYLHK5XMrKypLNZtOePXvkdrtjw6qsqJBh +GLo3Oho7e3R3dys9I0MWi0UbN25UQ0ODotFoLOC6ujo1NDQ8eXp9fDQ1m81xw4+3ndVqVWFhocrL +y3Xv3r0V914mk0l2u102m01VVVWyWCwJ7/ezDA0N6djRo3pz/365XC6ZzWb9yenU66+/rg8++EB2 +u12SdOHCBQUCATU1NWnDhg2yWCxKTU1VbW2tGhsb1d3drf/89NOjI+dzznm1eSVrfRN53zX7Me+K +Es1mFRcXKycnR6dOnZLP59OXX36pjz76SJmZmVpYWNCPP/6ocDisjo6OuD/jRjConY+fnVgsltiQ +l3M4HLEj/NLrsrOz9e3x42ppaZHb7Y77cNJifbFRPG276upqXb16VYFAQLW1tbGvDwwMaE9dXezs +9rz7/VuRSEQ//PCDamtrtWHDhqf+O2dmZnTu3DnVeb1KS0t74vuVlZU6e/asTp86pfKdO2OvSXTO +q0nW+ibb7xbI8rNJc3OzZDLJd+2aenp61NDQoKmpKYXDYR06dEhut1vRaDR2lF86SjztviXeUT8S +DscG/fbbb+vosWM6cuSIvF6v9uzZo9QkP/XevHmztm/fro6ODu0sL5fDblcoFNJPFy/qb++9F3vd +y+735OSk7t69q5plEcaz9AFJZkZG3O/b7Xbt2LlTly9d0vT0dNyInjXn1SRrfV/pj3mnp6cViUSe ++LrNZtNer1eS1HvtWuz6dPkATCaTzGZz7E8iw5MUG/ryZy8ul0t///BD7WtsVFdXl/515IhmZmaS +OliTyaSamhoZhqEbAwOxS6GqykrZbLYV1+Uvs98PHz58tJAJzmd2dvbpB6/09IT3L96cnyWZ6/vK +BjI4NPTEfcaStMeLsbQo6x5fJ48uu7Z8EeHHR5blv4ThcFh2u13eujodOnRI42Njunr1asI/MxJ9 +sQ/68vLylJObq3OdnVpcXNTFixe1bdu2Fa952f1eugQZGxt75uucTuejA1Jvb+yXNd6zBEnKzMx8 +oTk/a17JXN+XXac/LJBUh0NdXV1xP58ef7ygFRUVkqQN69fLnZ+vzs7OuEe5Bw8famJiYsXfw3FO +s4uLiyuOMAsLC7p0+XLs+263W6VlZU9su3SmW37aX7qJfjA/v+KsuPw18bZbvv1er1fjY2P6/vvv +lZ+fH7uGXvK8+/1b69ev1+acHHV2dsZ9znT37l3Nzs4qIyND9fX1mpmZkc/ni3updu3aNf15374V +l1eJznm1eSVrfRNdpzUZSHp6uvr6+vTtd99pZGREoVBIhmFoeHhYJ0+eVEVFhUpLS2M38fubmhQO +h/XN8eMaGRlROBxWKBTSnTt3dDMYjB0FZ2ZmNPzrrzIMY8WlkmEYGhwcjIURjUZltVp15vRp3b59 +W5FIRGNjYxq8eVNFRUUrbiBHRkZig10KOjMzU66NG+Xz+zU/P6/Z2Vn19vauut1yHo9HTqdTPT09 +KikpifvhRaL7HfdDAotFb+7fL5vNphMnTmh0dFSRSESGYSgYDOr+/ftKf3yW9nq9qqysVFtbm65c +uRL7JRwdHVXbiRPaXVOj2pqaFTf2ic55tXkla30TWac1+6BwYWFBP/f3y5mZqVu3bmngxg3NTE/L +4/GoqLhYWwsKYvUvL7+3t1d9fX2ypaRoa0GBSkpKlJWVJUnq6+vT119/vWKbt956S263W59//nns +5xmGIYfDoU8//VTt7e1KS0tTf3+/srKytGvXLuXm5kqSgsGg2tralJKSonA4LMMw5PF4dPDgwUeX +LuPjOt/ZqZGREe0sL1d1VZVSUlJW3W45n9+vyYkJ1dfXP/N+7Vn7vZqJiQn19vaqv79fZrNZhYWF +Ki0tfeJ5QCQS0dDQkAKBgG7cuCFJ2rp1q4qKimLPQF50ziaT6anzSub6JvK+a/ZJejIsfQKy/IYP +/ztzXkvra30VFy7RjwTxas55La0v/+UWIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQ +CEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCA +QAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEABAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCA +QAACAUAgAIEABAIQCEAgAIEABAIQCEAgAIEAIBCAQAACAQgEIBCAQAACAQgEIBAABAIQCEAgAIEA +BAIQCEAgAIEABAIQCAACAQgEIBCAQAACAQgEIBCAQAACAQgEAIEABAIQCEAgAIEABAIQCEAgAIEA +IBCAQICX9F8/bNVInwJ8BAAAAABJRU5ErkJggg==") + "The PNG data for a sensitive image placeholder.") + +(defun mastodon-media--process-image-response + (status-plist url marker image-options region-length) + "Callback function processing the url retrieve response for URL. +STATUS-PLIST is the usual plist of status events as per `url-retrieve'. +IMAGE-OPTIONS are the precomputed options to apply to the image. +MARKER is the marker to where the response should be visible. +REGION-LENGTH is the length of the region that should be replaced +with the image." + (when (marker-buffer marker) ; if buffer hasn't been killed + (let ((url-buffer (current-buffer)) + (is-error-response-p (eq :error (car status-plist)))) + (let* ((data (unless is-error-response-p + (goto-char (point-min)) + (and (search-forward "\n\n" nil t) + (buffer-substring (point) (point-max))))) + (image (when data + (apply #'create-image data ;; inbuilt scaling in 27.1: + (when (version< emacs-version "27.1") + (when image-options 'imagemagick)) + t image-options)))) + (when mastodon-media--enable-image-caching + (unless (url-is-cached url) ; cache if not already cached + (url-store-in-cache url-buffer))) + (with-current-buffer (marker-buffer marker) + ;; Save narrowing in our buffer + (let ((inhibit-read-only t)) + (save-restriction + (widen) + (put-text-property marker + (+ marker region-length) 'media-state 'loaded) + (when image + ;; We only set the image to display if we could load + ;; it; we already have set a default image when we + ;; added the tag. + (mastodon-media--display-image-or-sensitive + marker region-length image)) + ;; We are done with the marker; release it: + (set-marker marker nil))) + (kill-buffer url-buffer)))))) + +(defun mastodon-media--display-image-or-sensitive (marker region-length image) + "Display image using display property, or add sensitive mask. +MARKER, REGION-LENGTH and IMAGE are from +`mastodon-media--process-image-response'. +If the image is marked sensitive, the image is stored in +image-data prop so it can be toggled." + (if (or (not (eq t (get-text-property marker 'sensitive))) + (not mastodon-media--hide-sensitive-media)) + ;; display image + (put-text-property marker (+ marker region-length) + 'display image) + ;; display sensitive placeholder and save image data as prop: + (add-text-properties marker (+ marker region-length) + `(display + ;; (image :type png :data ,mastodon-media--sensitive-image-data) + ,(create-image + mastodon-media--sensitive-image-data nil t) + sensitive-state hidden image-data ,image)))) + +(defvar mastodon-media--attachments nil + "A list attachment details for full sized image view buffer. +The first element is the URL of the image displayed, followed by plists +of details of all of a toot's attachments.") + +(defun mastodon-media--process-full-sized-image-response + (status-plist url attachments &optional prev-buf) + ;; FIXME: refactor this with but not into + ;; `mastodon-media--process-image-response'. + "Callback function processing the `url-retrieve' response for URL. +URL is a full-sized image URL attached to a timeline image. +STATUS-PLIST is a plist of status events as per `url-retrieve'." + (if-let* ((error-response (plist-get status-plist :error))) + (user-error "error in loading image: %S" error-response) + (when mastodon-media--enable-image-caching + (unless (url-is-cached url) ;; cache if not already cached + (url-store-in-cache))) + ;; thanks to rahguzar for this idea: + ;; https://codeberg.org/martianh/mastodon.el/issues/540 + (let* ((handle (mm-dissect-buffer t)) + (image (mm-get-image handle)) + (str (image-property image :data)) + (buf "*masto-image*")) + (with-current-buffer (get-buffer-create buf) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-image image str) + (special-mode) ; prevent image-mode loop bug + (mastodon-image-mode) ;; for our keymap + (goto-char (point-min)) + (image-transform-fit-both) + ;; set image metadata for view cycling: + (setq-local mastodon-media--attachments (cons url attachments)))) + ;; switch to buf if not already viewing it: + (unless (equal buf prev-buf) + (switch-to-buffer-other-window buf)) + ;; display bindings if multiple images: + (when (< 1 (length (cdr mastodon-media--attachments))) + (message (substitute-command-keys + "\\`.'/\\`>'/\\`' to cycle images")))))) + +(defun mastodon-media--image-or-cached (url process-fun args) + "Fetch URL from cache or fro host. +Call PROCESS-FUN on it with ARGS, a list of callback args as +specified by `url-retrieve'." + (if (and mastodon-media--enable-image-caching + (url-is-cached url)) ;; if cached, decompress and use: + (with-current-buffer (url-fetch-from-cache url) + (set-buffer-multibyte nil) + (goto-char (point-min)) + (zlib-decompress-region + (goto-char (search-forward "\n\n")) (point-max)) + (apply process-fun args)) ;; no status-plist arg from cache + ;; fetch as usual and process-image-response will cache it: + ;; cbargs fun will be called with status-plist by url-retrieve: + (url-retrieve url process-fun (cdr args)))) + +(defun mastodon-media--load-image-from-url (url media-type start region-length) + "Take a URL and MEDIA-TYPE and load the image asynchronously. +MEDIA-TYPE is a symbol and either `avatar' or `media-link'. +START is the position where we start loading the image. +REGION-LENGTH is the range from start to propertize." + (let ((image-options + (when (mastodon-tl--image-trans-check) + (cond ((eq media-type 'avatar) + `(:height ,mastodon-media--avatar-height)) + ((eq media-type 'media-link) + `(:max-height ,mastodon-media--preview-max-height))))) + (buffer (current-buffer)) + (marker (copy-marker start)) + (url-show-status nil)) ; stop url.el from spamming us about connecting + (condition-case nil + ;; catch errors in url-retrieve to not break our caller + (mastodon-media--image-or-cached + url + #'mastodon-media--process-image-response + (list nil url marker image-options region-length)) + (error (with-current-buffer buffer + ;; TODO: Add retries + (put-text-property marker (+ marker region-length) + 'media-state 'loading-failed) + :loading-failed))))) + +(defun mastodon-media--select-next-media-line (end-pos) + "Find coordinates of the next media to load before END-POS. +Returns the list of (`start' . `end', `media-symbol') points of +that line and string found or nil no more media links were +found." + (let ((next-pos (point))) + (while + (and + (setq next-pos (next-single-property-change next-pos 'media-state)) + (or (not (eq 'needs-loading (get-text-property next-pos 'media-state))) + (null (get-text-property next-pos 'media-url)) + (null (get-text-property next-pos 'media-type)))) + ;; do nothing - the loop will proceed + ) + (when (and next-pos (< next-pos end-pos)) + (let ((media-type (get-text-property next-pos 'media-type))) + (cond + ((eq media-type 'avatar) ; avatars are one character + (list next-pos (+ next-pos 1) 'avatar)) + ((eq media-type 'media-link) ; media links are 5 characters: [img] + (list next-pos (+ next-pos 5) 'media-link))))))) + +(defun mastodon-media--valid-link-p (link) + "Check if LINK is valid. +Checks to make sure the missing string has not been returned." + (and link + (> (length link) 8) + (or (string= "http://" (substring link 0 7)) + (string= "https://" (substring link 0 8))))) + +(defun mastodon-media--inline-images (search-start search-end) + "Find all `Media_Links:' in the range from SEARCH-START to SEARCH-END. +Replace them with the referenced image." + (save-excursion + (goto-char search-start) + (let (line-details) + (while (setq line-details + (mastodon-media--select-next-media-line search-end)) + (let* ((start (car line-details)) + (end (cadr line-details)) + (media-type (cadr (cdr line-details))) + (type (get-text-property start 'mastodon-media-type)) + (image-url (get-text-property start 'media-url))) + (if (not (mastodon-media--valid-link-p image-url)) + ;; mark it at least as not needing loading any more + (put-text-property start end 'media-state 'invalid-url) + ;; proceed to load this image asynchronously + (put-text-property start end 'media-state 'loading) + (mastodon-media--load-image-from-url + image-url media-type start (- end start)) + (when (or (string= type "gifv") + (string= type "video")) + (mastodon-media--moving-image-overlay start end)))))))) + +;; (defvar-local mastodon-media--overlays nil +;; "Holds a list of overlays in the buffer.") + +(defun mastodon-media--moving-image-overlay (start end) + "Add play symbol overlay to moving image media items. +START and END are the beginning and end of the media item to overlay." + (let ((ov (make-overlay start end))) + (overlay-put + ov + 'after-string + (propertize "" + 'help-echo "Video" + 'face + '((:height 3.5 :inherit mastodon-toot-docs-face)))))) +;; (cl-pushnew ov mastodon-media--overlays))) + +(defun mastodon-media--get-avatar-rendering (avatar-url) + "Return the string to be written that renders the avatar at AVATAR-URL." + ;; We use just an empty space as the textual representation. + ;; This is what a user will see on a non-graphical display + ;; where not showing an avatar at all is preferable. + (let ((image-options (when (mastodon-tl--image-trans-check) + `(:height ,mastodon-media--avatar-height)))) + (concat + (propertize " " + 'media-url avatar-url + 'media-state 'needs-loading + 'media-type 'avatar + 'display + (apply #'create-image mastodon-media--generic-avatar-data + ;; inbuilt scaling in 27.1 + (when (version< emacs-version "27.1") + (when image-options 'imagemagick)) + t image-options)) + " "))) + +(defun mastodon-media--get-media-link-rendering + (media-url &optional full-remote-url type caption sensitive) + "Return the string to be written that renders the image at MEDIA-URL. +FULL-REMOTE-URL is used for `shr-browse-image'. +TYPE is the attachment's type field on the server. +CAPTION is the image caption if provided. +SENSITIVE is a flag from the item's JSON data." + (let* ((help-echo-base + (substitute-command-keys + (concat "\\`RET': load full image or play video,\ + \\`i' for image options" + (when (not (eq sensitive :json-false)) + ", \\`S': toggle sensitive media")))) + (help-echo (if caption + (concat help-echo-base + "\n\"" caption "\"") + help-echo-base))) + (concat + (mastodon-tl--propertize-img-str-or-url + "[img]" media-url full-remote-url type help-echo + (create-image mastodon-media--generic-broken-image-data nil t) + nil caption sensitive) + " "))) + +(provide 'mastodon-media) +;;; mastodon-media.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-notifications.el b/elpa/mastodon-20260406.856/mastodon-notifications.el new file mode 100644 index 00000000..5db7114e --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-notifications.el @@ -0,0 +1,1136 @@ +;;; 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 +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-notification.el provides notification functions for Mastodon. + +;;; Code: + +(require 'subr-x) +(require 'cl-lib) +(require 'mastodon-widget) +(require 'map) + +(declare-function alert-add-rule "alert") +(declare-function alert "alert") + +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-params-async-json "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") +(autoload 'mastodon-tl--byline "mastodon-tl") +(autoload 'mastodon-tl--byline-author "mastodon-tl") +(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") +(autoload 'mastodon-tl--content "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-tl--has-spoiler "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") +(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-tl--spoiler "mastodon-tl") +(autoload 'mastodon-tl--item-id "mastodon-tl") +(autoload 'mastodon-tl-update "mastodon-tl") +(autoload 'mastodon-views-view-follow-requests "mastodon-views") +(autoload 'mastodon-tl--current-filters "mastodon-views") +(autoload 'mastodon-tl--render-text "mastodon-tl") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-tl--byline-uname-+-handle "mastodon-tl") +(autoload 'mastodon-tl--byline-handle "mastodon-tl") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-media--get-avatar-rendering "mastodon-media") +(autoload 'mastodon-tl--image-trans-check "mastodon-tl") +(autoload 'mastodon-tl--symbol "mastodon-tl") +(autoload 'mastodon-tl--display-or-uname "mastodon-tl") +(autoload 'mastodon-tl-goto-next-item "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") +(autoload 'mastodon-tl--buffer-property "mastodon-tl") +(autoload 'mastodon-http--patch "mastodon-http") +(autoload 'mastodon-views--minor-view "mastodon-views") +(autoload 'mastodon-tl--goto-first-item "mastodon-tl") +(autoload 'mastodon-tl--init-sync "mastodon-tl") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-live-buffers "mastodon") +(autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-tl--insert-quoted "mastodon-tl") + +;; notifications defcustoms moved into mastodon.el +;; as some need to be available without loading this file + +(defvar mastodon-tl--shr-map-replacement) +(defvar mastodon-tl--horiz-bar) +(defvar mastodon-active-user) +(defvar mastodon-instance-url) +(defvar mastodon-tl--buffer-spec) +(defvar mastodon-tl--display-media-p) +(defvar mastodon-mode-map) +(defvar mastodon-tl--fold-toots-at-length) +(defvar mastodon-tl--show-avatars) +(defvar mastodon-profile-note-in-foll-reqs) +(defvar mastodon-profile-note-in-foll-reqs-max-length) +(defvar mastodon-group-notifications) +(defvar mastodon-notifications-grouped-names-count) +(defvar mastodon-tl--link-keymap) +(defvar mastodon-tl--update-point) +(defvar mastodon-notifications-alerts-interval) +(defvar mastodon-notifications-alert-style) +(defvar mastodon-notifications-alerts) +;;; VARIABLES + +(defvar mastodon-notifications--map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-mode-map) + (define-key map (kbd "a") #'mastodon-notifications-follow-request-accept) + (define-key map (kbd "j") #'mastodon-notifications-follow-request-reject) + (define-key map (kbd "C-k") #'mastodon-notifications-clear-current) + (define-key map (kbd "C-c C-c") #'mastodon-notifications-cycle-type) + map) + "Keymap for viewing notifications.") + +(defvar mastodon-notifications--types + '("all" "favourite" "reblog" "mention" "poll" + "follow_request" "follow" "status" "update" + "severed_relationships" "moderation_warning" "quote" + "quoted_update") + "A list of notification types according to their name on the server, plus \"all\".") + +(defvar mastodon-notifications--filter-types-alist + '(("all" . mastodon-notifications-get) + ("favourite" . mastodon-notifications-get-favourites) + ("reblog" . mastodon-notifications-get-boosts) + ("mention" . mastodon-notifications-get-mentions) + ("poll" . mastodon-notifications-get-polls) + ("follow_request" . mastodon-notifications-get-follow-requests) + ("follow" . mastodon-notifications-get-follows) + ("status" . mastodon-notifications-get-statuses) + ("update" . mastodon-notifications-get-edits) + ("quote" . mastodon-notifications-get-quotes) + ("quoted_update" . mastodon-notifications-get-quoted-updates)) + "An alist of notification types and their corresponding load functions. +Notification types are named according to their name on the server.") + +(defvar mastodon-notifications--response-alist + '(("Followed" . "you") + ("Favourited" . "your post") + ("Boosted" . "your post") + ("Mentioned" . "you") + ("Posted a poll" . "that has now ended") + ("Requested to follow" . "you") + ("Posted" . "a post") + ("Edited" . "their post") + ("Quoted" . "your post") + ;; FIXME: this is very annoying, but because "Edited" is used above, + ;; we cannot reuse it here. I think this is because we use + ;; `mastodon-notifications--action-alist' to go from (server) notif + ;; type, to a string, and then use that string to get the rest of the + ;; byline string from `mastodon-notifications--response-alist' here. + ;; Ideally would just key the two strings according to notif type, + ;; even if they did need to be gathered separately and combined. + ("Modified" . "a post that you quoted")) + "Alist of subjects for notification types.") + +(defvar mastodon-notifications--action-alist + '((reblog . "Boosted") + (favourite . "Favourited") + (follow_request . "Requested to follow") + (follow . "Followed") + (mention . "Mentioned") + (status . "Posted") + (poll . "Posted a poll") + (update . "Edited") + (severed_relationships . "Relationships severed") + (moderation_warning . "Moderation warning") + (quote . "Quoted") + (quoted_update . "Modified")) + "Action strings keyed by notification type. +Types are those of the Mastodon API.") + +(defvar mastodon-notifications--no-status-notif-alist + '(("moderation_warning" . moderation_warning) + ("severed_relationships" . event) + ("follow" . follow) + ("follow_request" . follow_request))) + +;;; VAR FETCHERS + +(defun mastodon-notifications--action-alist-get (type) + "Return an action string for notification TYPE. +Fetch from `mastodon-notifications--action-alist'. +If no match, return empty string." + (or (alist-get type mastodon-notifications--action-alist) + "")) + +(defun mastodon-notifications--response-alist-get (message) + "Return a response string for MESSAGE. +Fetch from `mastodon-notifications--response-alist'. +If no match, return empty string." + (or (alist-get + message + mastodon-notifications--response-alist nil nil #'equal) + "")) + +;;; UTILS + +(defun mastodon-notifications--api (endpoint) + "Return a notifications API ENDPOINT. +If `mastodon-group-notifications' is non-nil, use API v2." + (mastodon-http--api endpoint + (when mastodon-group-notifications "v2"))) + +;;; FOLL REQS + +(defun mastodon-notifications--follow-request-process (&optional reject) + "Process the follow request at point. +With no argument, the request is accepted. Argument REJECT means +reject the request. Can be called in notifications view or in +follow-requests view." + (if (not (mastodon-tl--find-property-range 'item-json (point))) + (user-error "No follow request at point?") + (let* ((item-json (mastodon-tl--property 'item-json)) + (f-reqs-view-p (string= "follow_requests" + (plist-get mastodon-tl--buffer-spec 'endpoint))) + (f-req-p (or (string= "follow_request" + (mastodon-tl--property 'notification-type + :no-move)) + f-reqs-view-p))) + (if (not f-req-p) + (user-error "No follow request at point?") + (let-alist (or (alist-get 'account item-json) ;notifs + item-json) ;f-reqs + (if (not .id) + (user-error "No account result at point?") + (let ((response + (mastodon-http--post + (mastodon-http--api + (format "follow_requests/%s/%s" + .id (if reject "reject" "authorize")))))) + (mastodon-http--triage + response + (lambda (_) + (if f-reqs-view-p + (mastodon-views-view-follow-requests) + (mastodon-tl--reload-timeline-or-profile)) + (message "Follow request of %s (@%s) %s!" + .username .acct (if reject "rejected" "accepted"))))))))))) + +(defun mastodon-notifications-follow-request-accept () + "Accept a follow request. +Can be called in notifications view or in follow-requests view." + (interactive) + (mastodon-notifications--follow-request-process)) + +(defun mastodon-notifications-follow-request-reject () + "Reject a follow request. +Can be called in notifications view or in follow-requests view." + (interactive) + (mastodon-notifications--follow-request-process :reject)) + +;;; FORMAT NON-STANDARD NOTIFS + +(defun mastodon-notifications--severance-body (json) + "Return a body for a severance notification JSON." + ;; https://docs.joinmastodon.org/entities/RelationshipSeveranceEvent/ + (let-alist json + (concat .type ": " + .target_name + "\nRelationships affected: " + "\nFollowers: " (number-to-string .followers_count) + "\nFollowing: " (number-to-string .following_count)))) + +(defun mastodon-notifications--mod-warning-body (json) + "Return a body for a moderation warning notification JSON." + ;; https://docs.joinmastodon.org/entities/AccountWarning/ + (let-alist json + (concat .action ": \"" (string-trim .text) "\"" + "\nStatuses: " + (mastodon-notifications--render-mod-status-links .status_ids) + "\nfor account: " + .target_account.acct + (if .appeal + (concat "\nYour appeal: \"" + (alist-get 'text .appeal) + "\"") + "") + "\nMore info/appeal: " + (mastodon-notifications--render-mod-link .id)))) + +(defun mastodon-notifications--propertize-link (url help-echo) + "Render a plain URL link with HELP-ECHO." + (propertize + url + 'face 'shr-link ;; mastodon-display-name-face + 'keymap mastodon-tl--shr-map-replacement + 'mastodon-tab-stop 'shr-url + 'help-echo help-echo + 'follow-link t + 'mouse-face 'highlight + 'shr-url url + 'keymap mastodon-tl--shr-map-replacement)) + +(defun mastodon-notifications--render-mod-status-links (ids) + "Render moderation status IDS as URLs." + (mapconcat (lambda (id) + (let ((str (format "%s/@%s/%s" + mastodon-instance-url + mastodon-active-user id))) + (mastodon-notifications--propertize-link str "view toot"))) + ids ", ")) + +(defun mastodon-notifications--render-mod-link (id) + "Render a moderation link for item with ID." + (let ((str (format "%s/disputes/strikes/%s" + mastodon-instance-url id))) + (mastodon-notifications--propertize-link str "View mod warning"))) + +;;; FORMAT/INSERT SINGLE NOTIF + +(defun mastodon-notifications--format-note (note) + "Format for a NOTE, a non-grouped notification." + (let* ((type (intern (alist-get 'type note))) + (profile-note + (when (eq 'follow_request type) + (let ((str (mastodon-tl--field + 'note + (mastodon-tl--field 'account note)))) + (if mastodon-profile-note-in-foll-reqs-max-length + (string-limit str mastodon-profile-note-in-foll-reqs-max-length) + str)))) + (status (mastodon-tl--field 'status note)) + (follower (alist-get 'account note)) + (follower-name (mastodon-notifications--follower-name follower)) + (filtered (mastodon-tl--field 'filtered status)) + (filters (when filtered + (mastodon-tl--current-filters filtered)))) + (if (and filtered (assoc "hide" filters)) + nil + (mastodon-notifications--insert-note + ;; toot + ;; should always be note, otherwise notif data not avail + ;; later on: + note + ;; body + (mastodon-notifications--body-arg + type filters status profile-note follower-name nil note) + ;; action-byline (top) + (mastodon-notifications--action-byline + type nil nil note follower-name) + ;; base toot (always provide) + status + nil nil nil type)))) + +(defun mastodon-notifications--format-group-note (group status accounts) + "Format for a GROUP notification. +STATUS is the status's JSON. +ACCOUNTS is data of the accounts that have reacted to the notification." + (let ((folded nil)) + ;; FIXME: apply/refactor filtering as per/with `mastodon-tl--toot' + (let-alist group + (let* ((type (intern .type)) + (profile-note + (when (member type '(follow_request)) + (let ((str (mastodon-tl--field 'note (car accounts)))) + (if mastodon-profile-note-in-foll-reqs-max-length + (string-limit str mastodon-profile-note-in-foll-reqs-max-length) + str)))) + (follower (when (member type '(follow follow_request)) + (car accounts))) + (follower-name (mastodon-notifications--follower-name follower)) + (filtered (mastodon-tl--field 'filtered status)) + (filters (when filtered + (mastodon-tl--current-filters filtered)))) + (unless (and filtered (assoc "hide" filters)) + (mastodon-notifications--insert-note + ;; toot + (if (member type '(follow follow_request)) + follower + status) + ;; body + (mastodon-notifications--body-arg + type filters status profile-note follower-name group) + ;; action-byline + (mastodon-notifications--action-byline + type accounts group) + ;; base toot (no need for update/poll/?) + (when (member type '(favourite reblog)) + status) + folded group accounts)))))) + +(defun mastodon-notifications--follower-name (follower) + "Return display_name or username of FOLLOWER." + (if (not (string= "" (alist-get 'display_name follower))) + (alist-get 'display_name follower) + (alist-get 'username follower))) + +(defun mastodon-notifications--comment-note-text (str) + "Add comment face to all text in STR with `shr-text' face only." + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (let (prop) + (while (setq prop (text-property-search-forward 'face 'shr-text t)) + (add-text-properties (prop-match-beginning prop) + (prop-match-end prop) + '(face (mastodon-toot-docs-face shr-text))))) + (buffer-string))) + +(defun mastodon-notifications--body-arg + (type &optional filters status profile-note follower-name group note) + "Prepare a notification body argument. +The string returned is passed to `mastodon-notifications--insert-note'. +TYPE is a symbol, a member of `mastodon-notifiations--types'. +FILTERS STATUS PROFILE-NOTE FOLLOWER-NAME GROUP NOTE." + (let ((body + (if-let* ((match (assoc "warn" filters))) + (mastodon-tl--spoiler status (cadr match)) + (mastodon-tl--clean-tabs-and-nl + (cond ((mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status)) + ((eq type 'follow_request) + (mastodon-tl--render-text profile-note)) + (t (mastodon-tl--content status))))))) + (cond + ((not (member (symbol-name type) + mastodon-notifications--types)) + "Unknown notification type.") + ((eq type 'follow) + (propertize "Congratulations, you have a new follower!" + 'face 'default + 'item-type 'follow-request)) ;; nav + ((eq type 'follow_request) + (concat + (propertize (format "You have a follow request from %s" + follower-name) + 'face 'default + 'item-type 'follow-request) ;; nav + (when mastodon-profile-note-in-foll-reqs + (concat + ":\n" + (mastodon-notifications--comment-note-text body))))) + ((eq type 'severed_relationships) + (mastodon-notifications--severance-body + (alist-get 'event (or group note)))) + ((eq type 'moderation_warning) + (mastodon-notifications--mod-warning-body + (alist-get 'moderation_warning (or group note)))) + ((member type '(favourite reblog)) + (propertize + (mastodon-notifications--comment-note-text body))) + (t body)))) + +(defun mastodon-notifications--insert-note + (toot body action-byline + &optional base-toot unfolded group accounts type) + "Display the content and byline of timeline element TOOT. +BODY will form the section of the toot above the byline. +AUTHOR-BYLINE is an optional function for adding the author +portion of the byline that takes one variable. By default it is +`mastodon-tl--byline-author'. +ACTION-BYLINE is a string, obtained by calling +`mastodon-notifications--action-byline'. +BASE-TOOT is the JSON of the toot responded to. +UNFOLDED is a boolean meaning whether to unfold or fold item if +foldable. +GROUP is the notification group data. +ACCOUNTS is the notification accounts data. +TYPE is notification type, used for non-group notifs." + (let* ((type (if type + (symbol-name type) ;; non-group + (alist-get 'type group))) + (toot-foldable + (and mastodon-tl--fold-toots-at-length + (length> body mastodon-tl--fold-toots-at-length))) + (ts ;; types listed here use base item timestamp, else we use + ;; group's latest timestamp: + (when (and group + (not + (member type '("favourite" "reblog" "edit" "poll")))) + (mastodon-tl--field 'latest_page_notification_at group)))) + (insert + (propertize ;; top byline, body + byline: + (concat + (if (equal type "mention") ;; top (action) byline + "" + action-byline) + (propertize body ;; body only + 'toot-body t) ;; includes newlines etc. for folding + "\n" + ;; display quoted post: + (when (alist-get 'quote toot) + (mastodon-tl--insert-quoted (alist-get 'quote toot) toot)) + ;; actual byline: + (if (member type '("severed_relationships" "moderation_warning")) + (propertize + (concat mastodon-tl--horiz-bar "\n") + 'byline t) + (mastodon-tl--byline toot nil nil base-toot group ts))) + 'item-type 'toot ;; for nav, actions, etc. + 'item-id (or (alist-get 'page_max_id group) ;; newest notif + (alist-get 'id toot)) ; toot id + 'base-item-id (mastodon-tl--item-id + ;; if status is a notif, get id from base-toot + ;; (-tl--item-id toot) will not work here: + (or base-toot + toot)) ; else normal toot with reblog check + 'item-json toot + 'base-toot base-toot + 'cursor-face 'mastodon-cursor-highlight-face + 'toot-foldable toot-foldable + 'toot-folded (and toot-foldable (not unfolded)) + ;; grouped notifs data: + 'notification-type type + 'notification-id (alist-get 'group_key group) + 'notification-group group + 'notification-accounts accounts + ;; for pagination: + 'notifications-min-id (alist-get 'page_min_id group) + 'notifications-max-id (alist-get 'page_max_id group)) + "\n"))) + +;;; BYLINES + +(defun mastodon-notifications--action-byline + (type &optional accounts group note follower-name) + "Return an action (top) byline for notification of TYPE. +ACCOUNTS and GROUP group are used by grouped notifications. +NOTE and FOLLOWER-NAME are used for non-grouped notifs." + (let* ((str-prefix (mastodon-notifications--action-alist-get type)) + (action-str + (unless (member type '(follow follow_request mention)) + (downcase + (mastodon-notifications--byline-action-str + str-prefix)))) + (action-symbol (if (eq type 'mention) + "" + (mastodon-tl--symbol type))) + (action-authors + (cond + ((not (member (symbol-name type) + mastodon-notifications--types)) + "") + ((member type + '(follow follow_request mention + severed_relationships moderation_warning)) + "") ;; mentions are normal statuses + (group + (mastodon-notifications--byline-accounts accounts group)) + (t (mastodon-tl--byline-handle note nil + follower-name + 'mastodon-display-name-face))))) + (propertize + (concat action-symbol " " action-authors action-str) + 'byline-top t))) + +(defun mastodon-notifications--byline-action-str (message) + "Return an action (top) byline string for TOOT with MESSAGE." + (let ((resp (mastodon-notifications--response-alist-get message))) + (concat " " + (propertize message 'face 'mastodon-boosted-face) + " " resp "\n"))) + +(defun mastodon-notifications--alist-by-value (str field json) + "From JSON, return the alist whose FIELD value matches STR. +JSON is a list of alists." + (cl-some (lambda (y) + (when (string= str (alist-get field y)) + y)) + json)) + +(defun mastodon-notifications--group-accounts (ids json) + "For IDS, return account data in JSON." + (cl-loop + for x in ids + collect (mastodon-notifications--alist-by-value x 'id json))) + +(defun mastodon-notifications--byline-accounts + (accounts group &optional avatar) + "Propertize author byline ACCOUNTS. +GROUP is the group notification data. +When AVATAR, include the account's avatar image." + (let ((total (alist-get 'notifications_count group)) + (accts mastodon-notifications-grouped-names-count)) + (concat + (string-trim ;; remove trailing newline + (cl-loop + for account in accounts + repeat accts + concat + (let-alist account + (concat + ;; avatar insertion moved up to `mastodon-tl--byline' by + ;; default to be outside 'byline propt. + (when (and avatar ; used by `mastodon-profile--format-user' + mastodon-tl--show-avatars + mastodon-tl--display-media-p + (mastodon-tl--image-trans-check)) + (mastodon-media--get-avatar-rendering .avatar)) + (let ((uname (mastodon-tl--display-or-uname account))) + (mastodon-tl--byline-handle account nil + uname 'mastodon-display-name-face)) + ", "))) + nil ", ") + (if (< accts total) + (let ((diff (- total accts))) + (propertize ;; help-echo remaining notifs authors: + (format " and %s other%s" diff (if (= 1 diff) "" "s")) + 'help-echo (mapconcat (lambda (a) + (propertize (alist-get 'username a) + 'face 'mastodon-display-name-face)) + (cddr accounts) ;; not first two + ", "))))))) + +;;; LOAD TIMELINE + +(defun mastodon-notifications--render (json no-group) + "Display grouped notifications in JSON. +NO-GROUP means don't render grouped notifications." + ;; (setq masto-grouped-notifs json) + (let ((start-pos (point))) + (if no-group + (cl-loop for x in json + do (mastodon-notifications--format-note x)) + (cl-loop + for g in (alist-get 'notification_groups json) + for accounts = (mastodon-notifications--group-accounts + (alist-get 'sample_account_ids g) + (alist-get 'accounts json)) + for type = (alist-get 'type g) + for status = (mastodon-notifications--status-or-event g type json) + do (mastodon-notifications--format-group-note g status accounts))) + (when mastodon-tl--display-media-p + ;; images-in-notifs custom is handeld in + ;; `mastodon-tl--media-attachment', not here + (mastodon-media--inline-images start-pos (point))))) + +(defun mastodon-notifications--status-or-event (group type json) + "Return a notification's status or event data. +Using GROUP data, notification TYPE, and overall notifs JSON." + (if (member type (map-keys mastodon-notifications--no-status-notif-alist)) + ;; notifs w no status data: + (let ((key (alist-get type mastodon-notifications--no-status-notif-alist + nil nil #'equal))) + (alist-get key group)) + (mastodon-notifications--alist-by-value + (alist-get 'status_id group) + 'id + (alist-get 'statuses json)))) + +(defun mastodon-notifications--empty-group-json-p (json) + "Non-nil if JSON is empty grouped notifs data." + (equal json '((accounts) (statuses) (notification_groups)))) + +(defun mastodon-notifications--timeline (json &optional type update) + "Format JSON in Emacs buffer. +Optionally specify TYPE. +UPDATE means we are updating, so skip some things." + (if (seq-empty-p json) + (user-error "Looks like you have no (more) notifications for now") + (unless update + (mastodon-widget--create + "Filter" mastodon-notifications--types + (or type "all") + (lambda (widget &rest _ignore) + (let ((value (widget-value widget))) + (mastodon-notifications-get-type value))) + :newline) + (insert "\n")) + ;; filtered/requests message: + (when (mastodon-notifications--notif-requests) + (insert + (substitute-command-keys + "You have filtered notifications. \ +\\[mastodon-notifications-requests] to view requests.\n\n"))) + ;; set update point: + (setq mastodon-tl--update-point (point)) + ;; render: + (setq mastodon-tl--update-point (point)) + (mastodon-notifications--render json + (not mastodon-group-notifications)) + (goto-char (point-min)) + ;; set last read notif ID: + (save-excursion + (mastodon-tl-goto-next-item :no-refresh) + (let ((id (mastodon-tl--property 'item-id))) ;; notif not base + (mastodon-notifications--set-last-read id))) + (unless update ;; already in tl--update + (mastodon-tl-goto-next-item)))) + +;;; VIEW LOADING FUNCTIONS + +(defun mastodon-notifications-get-type (&optional type) + "Read a notification type and load its timeline. +Optionally specify TYPE." + (interactive) + (let ((choice (or type + (completing-read + "View notifications: " + mastodon-notifications--filter-types-alist)))) + (funcall (alist-get + choice mastodon-notifications--filter-types-alist + nil nil #'equal)))) + +(defun mastodon-notifications-cycle-type (&optional prefix) + "Cycle the current notifications view. +With arg PREFIX, `completing-read' a type and load it." + (interactive "P") + ;; FIXME: do we need a sept buffer-type result for all notifs views? + (if (not (or (mastodon-tl--buffer-type-eq 'notifications) + (mastodon-tl--buffer-type-eq 'mentions))) + (user-error "Not in a notifications view") + (let* ((choice + (if prefix + (completing-read "Notifs by type: " + mastodon-notifications--types) + (mastodon-notifications--get-next-type))) + (fun (alist-get choice mastodon-notifications--filter-types-alist + nil nil #'equal))) + (funcall fun)))) + +(defun mastodon-notifications--current-type () + "Return the current notification type or nil." + (let* ((update-params (mastodon-tl--buffer-property + 'update-params nil :no-error))) + (alist-get "types[]" update-params nil nil #'equal))) + +(defun mastodon-notifications--get-next-type () + "Return the next notif type based on current buffer spec." + (let* ((type (mastodon-notifications--current-type))) + (if (not type) + (cadr mastodon-notifications--types) + (or (cadr (member type mastodon-notifications--types)) + (car mastodon-notifications--types))))) + +(defun mastodon-notifications-get-mentions () + "Display mention notifications in buffer." + (interactive) + (mastodon-notifications-get "mention" "mentions")) + +(defun mastodon-notifications-get-favourites () + "Display favourite notifications in buffer." + (interactive) + (mastodon-notifications-get "favourite" "favourites")) + +(defun mastodon-notifications-get-boosts () + "Display boost notifications in buffer." + (interactive) + (mastodon-notifications-get "reblog" "boosts")) + +(defun mastodon-notifications-get-polls () + "Display poll notifications in buffer." + (interactive) + (mastodon-notifications-get "poll" "polls")) + +(defun mastodon-notifications-get-statuses () + "Display status notifications in buffer. +Status notifications are created when you call +`mastodon-tl-enable-notify-user-posts'." + (interactive) + (mastodon-notifications-get "status" "statuses")) + +(defun mastodon-notifications-get-follows () + "Display follow notifications in buffer." + (interactive) + (mastodon-notifications-get "follow" "follows")) + +(defun mastodon-notifications-get-follow-requests () + "Display follow request notifications in buffer." + (interactive) + (mastodon-notifications-get "follow_request" "follow-requests")) + +(defun mastodon-notifications-get-edits () + "Display edited post notifications in buffer." + (interactive) + (mastodon-notifications-get "update" "edits")) + +(defun mastodon-notifications--filter-types-list (type) + "Return a list of notification types with TYPE removed." + (remove type mastodon-notifications--types)) + +;;; CLEAR/DISMISS NOTIFS + +(defun mastodon-notifications-clear-all () + "Clear all notifications." + (interactive) + (when (y-or-n-p "Clear all notifications?") + (let ((response + (mastodon-http--post + (mastodon-notifications--api "notifications/clear")))) + (mastodon-http--triage + response (lambda (_) + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "All notifications cleared!")))))) + +(defun mastodon-notifications-clear-current () + "Dismiss the notification at point." + (interactive) + (let* ((id (or ;; grouping enabled + ;; (*should* also work for ungrouped items): + (mastodon-tl--property 'notification-id) + ;; FIXME: are these all required? + (mastodon-tl--property 'item-id) + (mastodon-tl--field + 'id + (mastodon-tl--property 'item-json)))) + (endpoint (mastodon-notifications--api + (format "notifications/%s/dismiss" id))) + (response (mastodon-http--post endpoint))) + (mastodon-http--triage + response (lambda (_) + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Notification dismissed!"))))) + +;;; MISC + +(defun mastodon-notifications--set-last-read (id) + "Set the last read notification ID on the server." + (let ((endpoint (mastodon-http--api "markers")) + (params `(("notifications[last_read_id]" . ,id)))) + (mastodon-http--post endpoint params))) + +(defun mastodon-notifications--get-last-read () + "Return the last read notification ID from the server." + (let* ((params '(("timeline[]" . "notifications"))) + (endpoint (mastodon-http--api "markers")) + (resp (mastodon-http--get-json endpoint params))) + (map-nested-elt resp '(notifications last_read_id)))) + +(defun mastodon-notifications--get-single-notif () + "Return a single notification JSON for v2 notifs." + (interactive) + (let* ((id ;; grouped (should work for ungrouped items): + (mastodon-tl--property 'notification-id)) + (endpoint (mastodon-notifications--api + (format "notifications/%s" id))) + (response (mastodon-http--get-json endpoint))) + (message "%s" (prin1-to-string response)))) + +(defun mastodon-notifications--get-unread-count () + "Return the number of unread notifications for the current account." + ;; params: limit - max 1000, default 100, types[], exclude_types[], account_id + (let* ((endpoint "notifications/unread_count") + (url (mastodon-http--api endpoint + (when mastodon-group-notifications "v2"))) + ;; NB: sync request!: + (resp (mastodon-http--get-json url nil :silent))) + (alist-get 'count resp))) + +(when (and mastodon-notifications-alerts + (require 'alert nil :noerror)) + (alert-add-rule :mode 'mastodon-mode + :status '(buried visible idle selected) + :persistent + #'(lambda (info) + ;; If the buffer is buried, or the user has been idle + ;; for `alert-reveal-idle-time' seconds, make this + ;; alert persistent. Normally, alerts become + ;; persistent after `alert-persist-idle-time' seconds. + (memq (plist-get info :status) '(buried idle))) + ;; FIXME: if user configures this variable, we need to + ;; remove this rule and re-add it! or they need to restart + ;; emacs?: + :style mastodon-notifications-alert-style + :continue t)) + +;;; REVOKE QUOTED STATUS +;; POST /api/v1/statuses/:id/quotes/:quoting_status_id/revoke. +(defun mastodon-notifications-revoke-post-quote () + "Revoke the quote of a post from a quote notification." + (interactive) + ;; SCOPE required: check quote notif type, which will have user post in + ;; the "status" attribute: + (let* ((notif (mastodon-tl--property 'item-json :no-move)) + (id (map-nested-elt notif '(quote quoted_status id))) + (quote-id (alist-get 'id notif)) + (url (mastodon-http--api (format "statuses/%s/quotes/%s/revoke" + id quote-id)))) + (when (y-or-n-p "Revoke quote of post at point?") + (let ((resp (mastodon-http--post url))) + (mastodon-http--triage + resp + (lambda (_resp) + (message "Quote of post revoked!"))))))) + +;;; NOTIFICATION REQUESTS / FILTERING / POLICY + +(defvar mastodon-notifications--requests-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map mastodon-mode-map) + (define-key map (kbd "j") #'mastodon-notifications-request-reject) + (define-key map (kbd "a") #'mastodon-notifications-request-accept) + (define-key map (kbd "g") #'mastodon-notifications-requests) + map) + "Keymap for viewing follow requests.") + +;; FIXME: these are only for grouped notifs, else the fields are JSON bools +(defvar mastodon-notifications-policy-vals + '("accept" "filter" "drop")) + +(defun mastodon-notifications-get-policy () + "Return the notification filtering policy." + (let ((url (mastodon-notifications--api "notifications/policy"))) + (mastodon-http--get-json url))) + +(defun mastodon-notifications--notif-requests () + "Non-nil if the user currently has pending/filtered notifications. +Returns" + (let* ((policy (mastodon-notifications-get-policy)) + (count (map-nested-elt policy '(summary pending_notifications_count)))) + (if (and count (> count 0)) + count))) + +(defun mastodon-notifications--pending-p () + "Non-nil if there are any pending requests or notifications." + (let* ((json (mastodon-notifications-get-policy)) + (summary (alist-get 'summary json))) + (or (not (= 0 (alist-get 'pending_requests_count summary))) + (not (= 0 (alist-get 'pending_notifications_count summary)))))) + +(defun mastodon-notifications--update-policy (&optional params) + "Update notifications filtering policy. +PARAMS is an alist of parameters." + ;; https://docs.joinmastodon.org/methods/notifications/#update-the-filtering-policy-for-notifications + (let ((url (mastodon-notifications--api "notifications/policy"))) + (mastodon-http--patch url params))) + +(defun mastodon-notifications--get-requests (&optional params) + "Get a list of notification requests data from the server. +PARAMS is an alist of parameters." + ;; NB: link header pagination + (let ((url (mastodon-notifications--api "notifications/requests"))) + (mastodon-http--get-json url params))) + +(defun mastodon-notifications-request-accept (&optional reject) + "Accept a notification request for a user. +This will merge any filtered notifications from them into the main +notifications and accept any future notification from them. +REJECT means reject notifications instead." + ;; POST /api/v1/notifications/requests/:id/accept + (interactive) + (let* ((id (mastodon-tl--property 'item-id)) + (user (mastodon-tl--property 'notif-req-user)) + (url (mastodon-http--api + (format "notifications/requests/%s/%s" + id (if reject "dismiss" "accept")))) + (resp (mastodon-http--post url))) + (mastodon-http--triage + resp + (lambda (_resp) + (message "%s notifications from %s" + (if reject "Not accepting" "Accepting") user) + ;; reload view: + (mastodon-notifications-requests))))) + +(defun mastodon-notifications-request-reject () + "Reject a notification request for a user. +Rejecting a request means any notifications from them will continue to +be filtered." + (interactive) + (mastodon-notifications-request-accept :reject)) + +(defun mastodon-notifications-requests () + "Open a new buffer displaying the user's notification requests." + ;; calqued off `mastodon-views-view-follow-requests' + (interactive) + (mastodon-tl--init-sync + "notification-requests" + "notifications/requests" + 'mastodon-views--insert-notification-requests + nil + '(("limit" . "40")) ; server max is 80 + :headers + "notification requests" + "a/j - accept/reject request at point\n\ + n/p - go to next/prev request\n\ + \\[mastodon-notifications-policy] - set filtering policy") + (mastodon-tl--goto-first-item) + (with-current-buffer "*mastodon-notification-requests*" + (use-local-map mastodon-notifications--requests-map))) + +(defun mastodon-views--insert-notification-requests (json) + "Insert the user's current notification requests. +JSON is the data returned by the server." + (mastodon-views--minor-view + "notification requests" + #'mastodon-notifications--insert-users + json)) +;; masto-notif-req)) + +(defun mastodon-notifications--insert-users (json) + "Insert users list into the buffer. +JSON is the data from the server." + ;; calqued off `mastodon-views--insert-users-propertized-note' + ;; and `mastodon-search--insert-users-propertized' + (cl-loop for req in json + do (insert + (concat + (mastodon-notifications--format-req-user req) + mastodon-tl--horiz-bar "\n\n")))) + +(defun mastodon-notifications--format-req-user (req &optional note) + "Format a notification request user, REQ. +NOTE means to include a profile note." + ;; calqued off `mastodon-search--propertize-user' + (let-alist req + (propertize + (concat + (propertize .account.username + 'face 'mastodon-display-name-face + 'byline t + 'notif-req-user .account.username + 'item-type 'notif-req + 'item-id .id) ;; notif req id + " : \n : " + (propertize (concat "@" .account.acct) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + 'mastodon-tab-stop 'user-handle + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" .account.acct) + 'help-echo (concat "Browse user profile of @" .account.acct)) + " : \n" + (when note + (mastodon-tl--render-text .account.note .account)) + "\n") + 'item-json req))) + + +;;; UPDATES TIMER + +(defvar mastodon-notifications-notify-shown) + +(defvar mastodon-notifications-timer nil + "Timer to update the notifs buffer.") + +(defun mastodon-notifications-cancel-timer () + "Cancel `mastodon-notifications-timer'. +Also nil the variable." + (when (timerp mastodon-notifications-timer) + (cancel-timer mastodon-notifications-timer)) + (setq mastodon-notifications-timer nil)) + +(defun mastodon-notifications-notify (&optional count force) + "Send a desktop notification when we have COUNT unread notifications. +If COUNT is nil, fetch again from server (synchronously). +Uses `alert.el'. +When FORCE, skip all checks and show an alert (for debugging)." + (let ((count (or count (mastodon-notifications--get-unread-count)))) + (when (or force + (and (> count 0) + (not mastodon-notifications-notify-shown))) + (if (not (require 'alert nil :noerror)) + (message "mastodon.el: new notifications %s" count) + (alert (format "New notifications: %s" count) + :title "mastodon.el" + ;; adding an alert.el rule as per above doesn't always work + ;; if a non-mastodon.el buffer is active (despite the 'buried + ;; status setting), so let's just give it a masto buffer: + :buffer (car (mastodon-live-buffers)))) + (unless force + ;; we nil this in `mastodon-notifications-get': + (setq mastodon-notifications-notify-shown t))))) + +(defun mastodon-notifications--update-with-timer () + "Run a timer to update notifications. Added to `mastodon-mode-hook'." + (cond + ;; if no buffers: cancel our timer and do nothing else: + ((and (not (mastodon-live-buffers)) + ;; if we are loading a first mastodon.el buffer, the previous + ;; check fails, as `mastodon-mode-hook' necessariliy runs + ;; before we have buf-spec, which + ;; `mastodon-tl--get-buffer-type' relies on, and if we set + ;; buf-spec earlier, enabling the mode wipes it. So + ;; let's also check if the current buffer prefix is *mastodon-, + ;; which it will be when first calling `mastodon' at least + ;; (though not necessarily when loading other first mastodon.el + ;; buffers, such as new toot): + (not (string-prefix-p "*mastodon-" (buffer-name)))) + ;; if not masto buffers: cancel everything: + (mastodon-notifications-cancel-timer)) + ;; if a timer has already run but somehow + ;; `mastodon-notifications-timer' has not been nilled, assume it is a + ;; leftover and cancel it, otherwise our unless check below will always + ;; fail and no new timer will be created. + ;; NB: this gets called: + ;; - on creating a new mastodon.el buffer, + ;; - if an existing timer is run. + ;; in both cases, `timerp' should fail, but sometimes we have a + ;; zombie one somehow: + ((and (timerp mastodon-notifications-timer) + (timer--triggered mastodon-notifications-timer)) + (mastodon-notifications-cancel-timer)) + ;; maybe we can remove this unless check, and just always cancel and + ;; restart? that would have the effect of making the timer always + ;; run `mastodon-notifications-alerts-interval' seconds after opening + ;; a new mastodon.el buffer, or effectively only showing an alert if + ;; the user stops opening buffers: + (t + (unless mastodon-notifications-timer + ;; set new timer if we don't have one: + (setq mastodon-notifications-timer + (run-at-time mastodon-notifications-alerts-interval + nil #'mastodon-notifications--update-check)))))) + +(defun mastodon-notifications--update-check () + "Get unread notifications count from the server, asynchronously. +Called by `mastodon-notifications--update-with-timer'. +Callback is `mastodon-notifications--update-check-cb'." + (let* ((endpoint "notifications/unread_count") + (url (mastodon-http--api endpoint + (when mastodon-group-notifications "v2")))) + (mastodon-http--get-json-async + url nil :silent #'mastodon-notifications--update-check-cb))) + +(defun mastodon-notifications--update-check-cb (resp) + "Callback functions for handling unread notifs count response RESP." + (let ((count (alist-get 'count resp))) + (when (> count 0) + ;; (message "%s" (current-buffer)) ;; => *mastodon-home* / *messages* + + ;; FIXME: unsure how to check if notifications buffer is active + ;; here, as (current-buffer) returns different things if this is + ;; triggered with notifs buffer active! so let's skip it for now, + ;; and only ever notify, not update the notifs buffer. + + ;; (if ;;(not (mastodon-tl--buffer-type-eq 'notifications)) + ;; (not mastodon-notifications-update-when-unread) + (mastodon-notifications-notify count) + ;; run updates if in notifs buffer: + ;; (message "Updating mastodon.el notifications...") + ;; (undo-boundary) + ;; (mastodon-tl-update) + ;; (undo-boundary) + ;; (message "Updating mastodon.el notifications... Done."))) + ;; cancel and set new timer: + (mastodon-notifications-cancel-timer) + (mastodon-notifications--update-with-timer)))) + +(provide 'mastodon-notifications) +;;; mastodon-notifications.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-pkg.el b/elpa/mastodon-20260406.856/mastodon-pkg.el new file mode 100644 index 00000000..cd3630ad --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-pkg.el @@ -0,0 +1,12 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "mastodon" "20260406.856" + "Client for fediverse services using the Mastodon API." + '((emacs "29.1") + (persist "0.8") + (tp "0.8")) + :url "https://codeberg.org/martianh/mastodon.el" + :commit "5bba23045efda9f63c36ac431bec8f318a55e76a" + :revdesc "5bba23045efd" + :authors '(("Johnson Denen" . "johnson.denen@gmail.com") + ("Marty Hiatt" . "mousebot@disroot.org")) + :maintainers '(("Marty Hiatt" . "mousebot@disroot.org"))) diff --git a/elpa/mastodon-20260406.856/mastodon-profile.el b/elpa/mastodon-20260406.856/mastodon-profile.el new file mode 100644 index 00000000..677df5f4 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-profile.el @@ -0,0 +1,1283 @@ +;;; 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 +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-profile.el generates a stream of users toots. +;; To add +;; - Option to follow +;; - wheather they follow you or not +;; - Show only Media + +;;; Code: +(require 'seq) +(require 'cl-lib) +(require 'persist) +(require 'parse-time) +(require 'mastodon-http) +(eval-when-compile + (require 'mastodon-tl)) +(require 'mastodon-widget) +(require 'table) + +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-auth--get-account-name "mastodon-auth.el") +(autoload 'mastodon-http--api "mastodon-http.el") +(autoload 'mastodon-http--get-json "mastodon-http.el") +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-http--patch "mastodon-http") +(autoload 'mastodon-http--patch-json "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http.el") +(autoload 'mastodon-http--triage "mastodon-http.el") +(autoload 'mastodon-kill-window "mastodon") +(autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el") +(autoload 'mastodon-media--inline-images "mastodon-media.el") +(autoload 'mastodon-mode "mastodon.el") +(autoload 'mastodon-notifications-follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications-follow-request-reject "mastodon-notifications") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-tl--as-string "mastodon-tl.el") +(autoload 'mastodon-tl--buffer-type-eq "mastodon tl") +(autoload 'mastodon-tl--byline-author "mastodon-tl.el") +(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") +(autoload 'mastodon-tl--get-link-header-from-response "mastodon-tl") +(autoload 'mastodon-tl--init "mastodon-tl.el") +(autoload 'mastodon-tl--user-handles-get "mastodon-tl") +(autoload 'mastodon-tl--map-alist "mastodon-tl") +(autoload 'mastodon-tl--map-alist-vals-to-alist "mastodon-tl") +(autoload 'mastodon-tl--profile-buffer-p "mastodon tl") +(autoload 'mastodon-tl--property "mastodon-tl.el") +(autoload 'mastodon-tl--render-text "mastodon-tl.el") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--set-face "mastodon-tl.el") +(autoload 'mastodon-tl--symbol "mastodon-tl") +(autoload 'mastodon-tl--timeline "mastodon-tl.el") +(autoload 'mastodon-tl--toot "mastodon-tl") +(autoload 'mastodon-tl--item-id "mastodon-tl") +(autoload 'mastodon-toot--count-toot-chars "mastodon-toot") +(autoload 'mastodon-toot--get-max-toot-chars "mastodon-toot") +(autoload 'mastodon-views-add-account-to-list "mastodon-views") +(autoload 'mastodon-return-credential-account "mastodon") +(autoload 'mastodon-tl--buffer-property "mastodon-tl") +(autoload 'mastodon-search-query "mastodon-search") +(autoload 'mastodon-tl--field-status "mastodon-tl") +(autoload 'mastodon-toot--with-toot-item "mastodon-toot" nil nil 'macro) +(autoload 'mastodon-tl--toot-or-base "mastodon-tl") +(autoload 'mastodon-views--end-of-table "mastodon-views") +(autoload 'mastodon-tl--buttonify-link "mastodon-tl") +(autoload 'mastodon-tl-read-handle-annotated "mastodon-tl") + +(defvar mastodon-active-user) +(defvar mastodon-tl--horiz-bar) +(defvar mastodon-tl--update-point) +(defvar mastodon-toot--max-toot-chars) +(defvar mastodon-toot--visibility) +(defvar mastodon-toot--content-nsfw) +(defvar mastodon-tl--timeline-posts-count) +(defvar mastodon-group-notifications) + +(defvar-local mastodon-profile--account nil + "The data for the account being described in the current profile buffer.") + +(defvar mastodon-profile-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle) + (define-key map (kbd "C-c C-s") #'mastodon-profile-account-search) + (define-key map (kbd "C-c #") #'mastodon-profile-open-statuses-tagged) + map) + "Keymap for `mastodon-profile-mode'.") + +(define-minor-mode mastodon-profile-mode + "Toggle mastodon profile minor mode. +This minor mode is used for mastodon profile pages and adds a couple of +extra keybindings." + :init-value nil + :lighter " Profile" + :keymap mastodon-profile-mode-map + :group 'mastodon + :global nil) + +(defvar mastodon-profile-credential-account nil + "Holds the JSON data of the CredentialAccount entity. +It contains details of the current user's account.") + +(defvar mastodon-profile-acccount-preferences-data nil + "Holds the JSON data of the current user's preferences.") + +(defvar mastodon-profile-update-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'mastodon-profile-user-profile-send-updated) + (define-key map (kbd "C-c C-k") #'mastodon-profile-update-profile-note-cancel) + map) + "Keymap for `mastodon-profile-update-mode'.") + +(persist-defvar mastodon-profile-account-settings nil + "An alist of account settings saved from the server. +Other clients can change these settings on the server at any +time, so this list is not the canonical source for settings. It +is updated on entering mastodon mode and on toggle any setting it +contains. +This variable is set from data in +`mastodon-profile-credential-account' not +`mastodon-profile-account-preferences-data'.") + +(define-minor-mode mastodon-profile-update-mode + "Minor mode to update user profile." + :group 'mastodon-profile + :keymap mastodon-profile-update-mode-map + :global nil) + +(defun mastodon-profile--item-json () + "Get the next item-json." + (mastodon-tl--property 'item-json)) + +(defun mastodon-profile--make-author-buffer + (account &optional no-reblogs no-replies only-media tag max-id + skip-pinned) + "Take an ACCOUNT json and insert a user account into a new buffer. +NO-REBLOGS means do not display boosts in statuses. +NO-REPLIES means to exlude replies. +ONLY-MEDIA means show only posts containing attachments. +TAG is a hashtag to restrict posts to. +MAX-ID is a flag to include the max_id pagination parameter. +SKIP-PINNED means don't display pinned toots." + (mastodon-profile--make-profile-buffer-for + account "statuses" #'mastodon-tl--timeline no-reblogs nil + no-replies only-media tag max-id skip-pinned)) + +;;; PROFILE VIEW COMMANDS + +(defvar mastodon-profile--account-view-alist + '((statuses . mastodon-profile-open-statuses) + (no-boosts . mastodon-profile-open-statuses-no-reblogs) + (no-replies . mastodon-profile-open-statuses-no-replies) + (only-media . mastodon-profile-open-statuses-only-media) + (followers . mastodon-profile-open-followers) + (following . mastodon-profile-open-following) + (tag . mastodon-profile-open-statuses-tagged))) + +(defun mastodon-profile--view-types () + "Return the keys of `mastodon-profile--account-view-alist' as a list." + (map-keys mastodon-profile--account-view-alist)) + +(defun mastodon-profile-account-view-cycle (&optional prefix) + "Cycle through profile view: toots, toot sans boosts, followers, and following. +If a PREFIX argument is provided, prompt for a view type and load." + (interactive "P") + (if prefix + (let* ((choice + (completing-read "Profile view:" + mastodon-profile--account-view-alist)) + (fun (alist-get choice mastodon-profile--account-view-alist))) + (funcall fun)) + (cond ((mastodon-tl--buffer-type-eq 'profile-statuses) + (mastodon-profile-open-statuses-no-reblogs)) + ((mastodon-tl--buffer-type-eq 'profile-statuses-no-boosts) + (mastodon-profile-open-statuses-no-replies)) + ((mastodon-tl--buffer-type-eq 'profile-statuses-no-replies) + (mastodon-profile-open-statuses-only-media)) + ((mastodon-tl--buffer-type-eq 'profile-statuses-only-media) + (mastodon-profile-open-followers)) + ((mastodon-tl--buffer-type-eq 'profile-followers) + (mastodon-profile-open-following)) + ((mastodon-tl--buffer-type-eq 'profile-following) + (mastodon-profile-open-statuses))))) + +(defun mastodon-profile-open-statuses () + "Open a profile showing statuses." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer + mastodon-profile--account) + (user-error "Not in a mastodon profile"))) + +(defun mastodon-profile-open-statuses-no-replies () + "Open a profile buffer showing statuses without replies." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer + mastodon-profile--account nil :no-replies) + (user-error "Not in a mastodon profile"))) + +(defun mastodon-profile-open-statuses-no-reblogs () + "Open a profile buffer showing statuses without reblogs." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer + mastodon-profile--account :no-reblogs) + (user-error "Not in a mastodon profile"))) + +(defun mastodon-profile-open-statuses-only-media () + "Open a profile buffer showing only statuses with media." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer + mastodon-profile--account nil nil :only-media nil nil :skip-pinned) + (user-error "Not in a mastodon profile"))) + +(defun mastodon-profile-open-statuses-tagged (&optional tag) + "Prompt for a TAG and display a profile with statuses containing it." + (interactive) + (let ((tag (or tag (read-string "Statuses containing tag: ")))) + (if mastodon-profile--account + (mastodon-profile--make-author-buffer mastodon-profile--account nil nil nil tag nil :skip-pinned) + (user-error "Not in a mastodon profile")))) + +(defun mastodon-profile-open-following () + "Open a profile buffer showing the accounts that current profile follows." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-profile-buffer-for + mastodon-profile--account "following" + #'mastodon-profile--format-user nil :headers) + (user-error "Not in a mastodon profile"))) + +(defun mastodon-profile-open-followers () + "Open a profile buffer showing the accounts following the current profile." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-profile-buffer-for + mastodon-profile--account "followers" + #'mastodon-profile--format-user nil :headers) + (user-error "Not in a mastodon profile"))) + +(defun mastodon-profile-view-favourites () + "Open a new buffer displaying the user's favourites." + (interactive) + (message "Loading your favourited toots...") + (mastodon-tl--init "favourites" "favourites" + 'mastodon-tl--timeline :headers)) + +(defun mastodon-profile-view-bookmarks () + "Open a new buffer displaying the user's bookmarks." + (interactive) + (message "Loading your bookmarked toots...") + (mastodon-tl--init "bookmarks" "bookmarks" + 'mastodon-tl--timeline :headers)) + +(defun mastodon-profile-add-account-to-list () + "Add account of current profile buffer to a list." + (interactive) + (if (not mastodon-profile--account) + (user-error "No profile to add?") + (let-alist mastodon-profile--account + (mastodon-views-add-account-to-list nil .id .acct)))) + +(defun mastodon-profile-account-search (query) + "Run a statuses search QUERY for the currently viewed account." + (interactive "sSearch account for: ") + (let* ((ep (mastodon-tl--buffer-property 'endpoint)) + (id (nth 1 (split-string ep "/")))) + (mastodon-search-query query "statuses" nil nil id))) + + +;;; ACCOUNT PREFERENCES + +(defun mastodon-profile--get-account-value (key function) + "Fetch KEY from data returned by FUNCTION. +If value is :json-false, return nil." + (let* ((response (funcall function)) + (value (alist-get key response))) + (if (eq value :json-false) nil value))) + +(defun mastodon-profile--get-json-value (key) + "Fetch value for KEY from account. +Account details are from `mastodon-return-credential-account'. +If value is :json-false, return nil." + (mastodon-profile--get-account-value + key #'mastodon-return-credential-account)) + +(defun mastodon-profile--get-source-values () + "Return the \"source\" preferences from the server." + (mastodon-profile--get-json-value 'source)) + +(defun mastodon-profile--get-source-value (pref) + "Return PREF erence from the account's \"source\" field." + (mastodon-profile--get-account-value + pref #'mastodon-profile--get-source-values)) + +(defun mastodon-profile-update-user-profile-note () + "Fetch user's profile note and display for editing." + (interactive) + (let* ((source (mastodon-profile--get-source-values)) + (note (alist-get 'note source)) + (buffer (get-buffer-create "*mastodon-update-profile*")) + (inhibit-read-only t) + (msg-str + (substitute-command-keys + "Edit your profile note. \\`C-c C-c' to send, \\`C-c C-k' to cancel."))) + (switch-to-buffer-other-window buffer) + (text-mode) + (mastodon-tl--set-buffer-spec (buffer-name buffer) + "accounts/verify_credentials" nil) + (setq-local header-line-format msg-str) + (mastodon-profile-update-mode t) + (insert (propertize (concat + (propertize "0" + 'note-counter t + 'display nil) + "/500 characters") + 'read-only t + 'face 'mastodon-toot-docs-face + 'note-header t) + "\n") + (make-local-variable 'after-change-functions) + (cl-pushnew #'mastodon-profile--update-note-count after-change-functions) + (let ((start-point (point))) + (insert note) + (goto-char start-point)) + (delete-trailing-whitespace) ; remove all ^M's + (message msg-str))) + +(defun mastodon-profile--update-note-count (&rest _args) + "Display the character count of the profile note buffer." + (let* ((inhibit-read-only t) + (header-region (mastodon-tl--find-property-range 'note-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'note-counter + (point-min))) + (count (number-to-string (mastodon-toot--count-toot-chars + (buffer-substring-no-properties + (cdr header-region) (point-max)))))) + (add-text-properties (car count-region) (cdr count-region) + (list 'display count)))) + +(defun mastodon-profile-update-profile-note-cancel () + "Cancel updating user profile and kill buffer and window." + (interactive) + (when (y-or-n-p "Cancel updating your profile note?") + (mastodon-kill-window))) + +(defun mastodon-profile--note-remove-header () + "Get the profile note, without the buffer header." + (let ((header-region (mastodon-tl--find-property-range 'note-header + (point-min)))) + (buffer-substring (cdr header-region) (point-max)))) + +(defun mastodon-profile-user-profile-send-updated () + "Send PATCH request with the updated profile note. +Ask for confirmation if length > 500 characters." + (interactive) + (let* ((note (mastodon-profile--note-remove-header)) + (url (mastodon-http--api "accounts/update_credentials"))) + (when (or (not (> (mastodon-toot--count-toot-chars note) 500)) + (y-or-n-p "Note is over mastodon's max for profile notes (500). Proceed?")) + (quit-window 'kill) + (mastodon-profile--user-profile-send-updated-do url note)))) + +(defun mastodon-profile--user-profile-send-updated-do (url note) + "Send PATCH request with the updated profile NOTE to URL." + (let ((response (mastodon-http--patch url `(("note" . ,note))))) + (mastodon-http--triage response + (lambda (_) (message "Profile note updated!"))))) + +(defun mastodon-profile--update-preference (pref val &optional source) + "Update account PREF erence to setting VAL. +Both args are strings. +SOURCE means that the preference is in the `source' part of the account JSON." + (let* ((url (mastodon-http--api "accounts/update_credentials")) + (pref-formatted (if source (concat "source[" pref "]") pref)) + (response (mastodon-http--patch url `((,pref-formatted . ,val))))) + (mastodon-http--triage response + (lambda (_) + (mastodon-profile--fetch-server-account-settings) + (message "Account setting %s updated to %s!" pref val))))) + +(defun mastodon-profile--get-pref (pref) + "Return PREF from `mastodon-profile-account-settings'." + (plist-get mastodon-profile-account-settings pref)) + +(defun mastodon-profile--update-preference-plist (pref val) + "Set local account preference plist preference PREF to VAL. +This is done after changing the setting on the server." + (setq mastodon-profile-account-settings + (plist-put mastodon-profile-account-settings pref val))) + +;; used in toot.el +(defun mastodon-profile--fetch-server-account-settings-maybe () + "Fetch account settings from the server. +Only do so if `mastodon-profile-account-settings' is nil." + (mastodon-profile--fetch-server-account-settings :no-force)) + +;; FIXME: this does one request per setting! should just do one request then +;; parse +(defun mastodon-profile--fetch-server-account-settings (&optional no-force) + "Fetch basic account settings from the server. +Store the values in `mastodon-profile-account-settings'. +Run in `mastodon-mode-hook'. +If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." + (unless (and no-force mastodon-profile-account-settings) + (let ((keys '(locked discoverable display_name bot)) + (source-keys '(privacy sensitive language))) + (mapc (lambda (k) + (mastodon-profile--update-preference-plist + k (mastodon-profile--get-json-value k))) + keys) + (mapc (lambda (sk) + (mastodon-profile--update-preference-plist + sk (mastodon-profile--get-source-value sk))) + source-keys) + ;; hack for max toot chars: + (mastodon-toot--get-max-toot-chars :no-toot) + (mastodon-profile--update-preference-plist 'max_toot_chars + mastodon-toot--max-toot-chars) + ;; TODO: remove now redundant vars, replace with fetchers from the plist + (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) + mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) + mastodon-profile-account-settings))) + +(defun mastodon-profile-account-locked-toggle () + "Toggle the locked status of your account. +Locked means follow requests have to be approved." + (interactive) + (mastodon-profile--toggle-account-key 'locked)) + +(defun mastodon-profile-account-discoverable-toggle () + "Toggle the discoverable status of your account. +Discoverable means the account is listed in the server directory." + (interactive) + (mastodon-profile--toggle-account-key 'discoverable)) + +(defun mastodon-profile-account-bot-toggle () + "Toggle the bot status of your account." + (interactive) + (mastodon-profile--toggle-account-key 'bot)) + +(defun mastodon-profile-account-sensitive-toggle () + "Toggle the sensitive status of your account. +When enabled, statuses are marked as sensitive by default." + (interactive) + (mastodon-profile--toggle-account-key 'sensitive :source)) + +(defun mastodon-profile--toggle-account-key (key &optional source) + "Toggle the boolean account setting KEY. +SOURCE means the setting is located under \"source\" in the account JSON. +Current settings are fetched from the server." + (let* ((val (if source + (mastodon-profile--get-source-value key) + (mastodon-profile--get-json-value key))) + (prompt (format "Account setting %s is %s. Toggle?" key val))) + (when (y-or-n-p prompt) + (mastodon-profile--update-preference (symbol-name key) + (if val "false" "true") + source)))) + +(defun mastodon-profile--edit-string-value (key) + "Edit the string for account preference KEY." + (let* ((val (mastodon-profile--get-json-value key)) + (new-val (read-string (format "Edit account setting %s: " key) + val))) + (mastodon-profile--update-preference (symbol-name key) new-val))) + +(defun mastodon-profile-update-display-name () + "Update display name for your account." + (interactive) + (mastodon-profile--edit-string-value 'display_name)) + +(defun mastodon-profile--make-meta-fields-params (fields) + "Construct a parameter query string from metadata alist FIELDS. +Returns an alist." + (let ((keys + (cl-loop + for count from 1 to 5 + collect (cons (format "fields_attributes[%s][name]" count) + (format "fields_attributes[%s][value]" count))))) + (cl-loop for a-pair in keys + for b-pair in fields + append (list (cons (car a-pair) (car b-pair)) + (cons (cdr a-pair) (cdr b-pair)))))) + +(defun mastodon-profile-update-meta-fields () + "Prompt for new metadata fields information and PATCH the server." + (interactive) + (let* ((url (mastodon-http--api "accounts/update_credentials")) + (fields-updated (mastodon-profile--update-meta-fields-alist)) + (params (mastodon-profile--make-meta-fields-params fields-updated)) + (response (mastodon-http--patch url params))) + (mastodon-http--triage response + (lambda (_) + (mastodon-profile--fetch-server-account-settings) + (message "Metadata fields updated to %s!" + fields-updated))))) + +(defun mastodon-profile--update-meta-fields-alist () + "Prompt for new metadata fields information. +Returns the results as an alist." + (let ((fields-old (mastodon-profile--fields-get + nil ;; we must fetch the plaintext version: + (mastodon-profile--get-source-value 'fields)))) + ;; offer empty fields if user currently has less than four filled: + (while (< (length fields-old) 4) + (setq fields-old (append fields-old '(("" . ""))))) + (let* ((f-str "Metadata %s [%s/4] (max. 255 chars): ") + (alist + (cl-loop for f in fields-old + for x from 1 to 5 + collect + (cons (read-string (format f-str "key" x) (car f)) + (read-string (format f-str "value" x) (cdr f)))))) + (mapcar (lambda (x) + (cons (mastodon-profile--limit-to-255 (car x)) + (mastodon-profile--limit-to-255 (cdr x)))) + alist)))) + +(defun mastodon-profile--limit-to-255 (x) + "Limit string X to 255 chars max." + (if (> (length x) 255) (substring x 0 255) x)) + +;; used in tl.el and toot.el: +(defun mastodon-profile--get-preferences-pref (pref) + "Fetch PREF from the endpoint \"/preferences\". +If `mastodon-profile-acccount-preferences-data' is set, fetch +from that instead. +The endpoint only holds a few preferences. For others, see +`mastodon-profile--update-preference' and its endpoint, +\"/accounts/update_credentials.\"" + (alist-get pref + (or mastodon-profile-acccount-preferences-data + (setq mastodon-profile-acccount-preferences-data + (mastodon-http--get-json + (mastodon-http--api "preferences")))))) + +(defun mastodon-profile-view-preferences () + "View user preferences in another window." + (interactive) + (let* ((url (mastodon-http--api "preferences")) + (response (mastodon-http--get-json url)) + (buf (get-buffer-create "*mastodon-preferences*"))) + (with-mastodon-buffer buf #'special-mode :other-window + (mastodon-tl--set-buffer-spec (buffer-name buf) "preferences" nil) + (while-let ((el (pop response))) + (insert (format "%-30s %s" + (prin1-to-string (car el)) + (prin1-to-string (cdr el))) + "\n\n")) + (goto-char (point-min))))) + +(defvar mastodon-profiles-quote-policy-types + '(public followers nobody)) + +(defun mastodon-profile-set-quote-policy () + "Prompt for a quote policy and set it in the user's preferences." + (interactive) + (let* ((prefs + ;; this fetches from a local var, we want to fetch from server, + ;; else we need this var to update when we change this setting: + ;; (mastodon-profile--get-source-values)) + ;; so we fetch from preferences instead: + (mastodon-http--get-json (mastodon-http--api "preferences"))) + (current (alist-get 'posting:default:quote_policy prefs)) + (choice (completing-read + (format "Set default quote policy [current: %s]: " current) + mastodon-profiles-quote-policy-types nil :match))) + (mastodon-profile--update-preference "quote_policy" choice 'source))) + + +;;; PROFILE VIEW DETAILS + +(defun mastodon-profile--relationships-get (id) + "Fetch info about logged-in user's relationship to user with id ID." + (let* ((args `(("id[]" . ,id))) + (url (mastodon-http--api "accounts/relationships"))) + ;; FIXME: API takes array, we just get 1st + (car (mastodon-http--get-json url args)))) + +(defun mastodon-profile--fields-get (&optional account fields) + "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. +Returns an alist. +FIELDS means provide a fields vector fetched by other means." + (let ((fields (or fields (alist-get 'fields account)))) + (when fields + (mastodon-tl--map-alist-vals-to-alist 'name 'value fields)))) + +(defun mastodon-profile--format-fields (fields) + "Format field pairs (a.k.a profile metadata) in FIELDS." + ;; prevent `mastodon-tl--render-text' from adding any newlines: + (let* ((mastodon-tl--no-fill-on-render t) + ;; render sans variable pitch: + ;; (mastodon-tl--enable-proportional-fonts nil) + ;; to set cell witdth right, we have to render any html first: + (rendered (mapcar (lambda (x) + (cons + (mastodon-tl--render-text (car x) x) + (mastodon-tl--render-text (cdr x) x))) + fields)) + (left-longest (apply #'max (mapcar #'length + (mapcar #'car rendered)))) + (left-width (min 30 left-longest)) + (right-longest (apply #'max (mapcar #'length + (mapcar #'cdr rendered)))) + ;; some people have very long URLs in their entries, so we set a + ;; max of (- window-width left-width). that way, long cells will + ;; run over onto multiple lines when we enable + ;; `table-fixed-width-mode': + (right-width (min + (if (> (frame-width) left-width) + (- (frame-width) (+ 10 left-width)) + ;; bizarre fallback: + (/ (frame-width) 3)) ;; 30) + right-longest))) + (mastodon-profile--pretty-table + #'mastodon-profile--insert-fields + `(,(+ 2 left-width) ,(+ 2 right-width)) rendered))) + +(defun mastodon-profile--pretty-table (insert-fun &optional min-cell-width + &rest insert-args) + "Insert some data and make a pretty table of it with table.el. +Call INSERT-FUN with INSERT-ARGS. +MIN-CELL-WIDTH is for `table-capture'. +Note that it can be a list of values, one for each column." + (let* ((mastodon-tl--no-fill-on-render t) + (table-cell-horizontal-chars + (if (char-displayable-p ?–) "–" "-")) + (mastodon-tl--enable-proportional-fonts nil) + (beg (point))) + ;; remove crazy table-cell face: + (face-remap-add-relative 'table-cell 'default) + (apply insert-fun insert-args) + (table-capture beg (point) "|" "\n" nil min-cell-width) + ;; center our content by col: + (let* ((cols (nth 4 (table-query-dimension)))) + (dotimes (_x cols) + (table-justify-column 'center) + (table-forward-cell))) + ;; (table-release) ;; removes frame, but fixes links + (mastodon-views--end-of-table) + (table-fixed-width-mode 1) + ;; unfuck `table-fixed-width-mode' disastrous face handling: + (set-face-attribute 'table-cell nil :inverse-video nil) + (add-text-properties beg (point) '(face 'success)))) + +(defun mastodon-profile-table-cell-hook-fun () + "Hook function for `table-cell-map-hook'. +We ensure we have our tab/click/RET bindings active for links." + (define-key table-cell-map + [remap table-forward-cell] #'mastodon-tl-next-tab-item) + (define-key table-cell-map + [remap table-backward-cell] #'mastodon-tl-previous-tab-item) + (define-key table-cell-map + [remap *table--cell-newline] #'mastodon-tl-do-link-action-at-point) + (define-key table-cell-map [mouse-2] #'mastodon-tl-do-link-action) + (define-key table-cell-map [follow-link] 'mouse-face)) + +(defun mastodon-profile--insert-fields (fields) + "Insert profile metadata FIELDS, an alist. +Format them so we can create a pretty table." + (insert + (mapconcat + (lambda (field) + (concat + (mastodon-profile--sane-field-str (car field)) + " | " + (mastodon-profile--sane-field-str (cdr field)))) + fields "\n"))) + +(defun mastodon-profile--sane-field-str (str) + "In STR, replace | with / and trim spaces/newlines. +We replace | because it is our pretty table's column delimiter." + (string-trim + (replace-regexp-in-string "|" "/" str) + "[ \n]")) + +(defun mastodon-profile--get-statuses-pinned (account) + "Fetch the pinned toots for ACCOUNT." + (let* ((id (alist-get 'id account)) + (args `(("pinned" . "true"))) + (url (mastodon-http--api (format "accounts/%s/statuses" id)))) + (mastodon-http--get-json url args))) + +(defun mastodon-profile--insert-statuses-pinned (pinned-statuses) + "Insert each of the PINNED-STATUSES for a given account." + (cl-loop for s in pinned-statuses + do (progn + (insert + (concat "\n " + (propertize " pinned " + 'face '(:inherit success :box t)) + " ")) + (mastodon-tl--toot s)))) + +(defun mastodon-profile--follows-p (list) + "T if you have any relationship with the accounts in LIST." + (let (result) + (dolist (x list result) + (when (not (eq :json-false x)) + (setq result x))))) + +(defun mastodon-profile--render-roles (roles) + "Return a propertized string of badges for ROLES." + (mapconcat + (lambda (role) + (propertize (alist-get 'name role) + 'face `(:box t :foreground ,(alist-get 'color role)))) + roles)) + +(defun mastodon-profile--render-moved (data) + "Return a propertized string of a migrated account link. +DATA is an account data from a moved field in profile data." + (let-alist data + (let ((handle (concat "@" .acct))) + (concat + "this account has migrated to: " + (mastodon-tl--buttonify-link + handle + 'face 'shr-link ;'mastodon-handle-face + 'mastodon-tab-stop 'user-handle + 'shr-url .url + 'mastodon-handle handle + 'help-echo (concat "Browse user profile of " handle)) + "\n\n")))) + +(defun mastodon-profile--insert-counts (toots followers following) + "Insert counts as a pretty table. +TOOTS FOLLOWERS and FOLLOWING are each integers." + (let ((table-cell-horizontal-chars (if (char-displayable-p ?–) + "–" + "-")) + (toot-cell (concat " TOOTS: " (mastodon-tl--as-string toots))) + (followers-cell (concat "FOLLOWERS: " + (mastodon-tl--as-string followers))) + (following-cell (concat "FOLLOWING: " + (mastodon-tl--as-string following)))) + (mastodon-profile--pretty-table + (lambda () + (insert + (concat toot-cell " | " followers-cell " | " following-cell + "\n"))) + `(,(+ 2 (length toot-cell)) ,(+ 2 (length followers-cell)) + ,(+ 2 (length following-cell)))))) + +(defun mastodon-profile--insert-joined (joined) + "Insert JOINED data as a pretty table." + (let ((join-str "Joined: ") + (date-str (mastodon-profile--format-joined-date-string joined))) + (mastodon-profile--pretty-table + (lambda () (insert join-str "|" date-str)) + `(,(+ 2 (length join-str)) ,(+ 2 (length date-str)))))) + +(defun mastodon-profile--insert-relationships (relationships) + "Insert RELATIONSHIPS data." + (let-alist relationships + ;; (sharkey has no relationships endpoint, returns 500. + ;; or poss it has a different endpoint?:) + (when .id + (let* ((followsp + (mastodon-profile--follows-p + (list .requested_by .following .followed_by .blocked_by))) + (rels (mastodon-profile--relationships-get .id)) + (langs-filtered (when-let* ((langs (alist-get 'languages rels))) + (concat " (" + (mapconcat #'identity langs " ") + ")"))) + (fold-str (concat "FOLLOWED BY YOU |" langs-filtered)) + (fols-str "FOLLOWS YOU |") + (req-str "REQUESTED TO FOLLOW YOU |") + (block-str "BLOCKS YOU |") + (str-list (cl-remove + nil (list (when (eq .following t) fold-str) + (when (eq .followed_by t) fols-str) + (when (eq .requested_by t) req-str) + (when (eq .blocked_by t) block-str))))) + (when followsp + (mastodon-profile--pretty-table + (lambda () + (insert + (apply #'concat str-list))) + (cl-loop for x in str-list + collect (+ 2 (length x))))))))) + +(defun mastodon-profile--make-profile-buffer-for + (account endpoint-type update-function + &optional no-reblogs headers no-replies only-media tag max-id + skip-pinned) + "Display profile of ACCOUNT, using ENDPOINT-TYPE and UPDATE-FUNCTION. +NO-REBLOGS means do not display boosts in statuses. +HEADERS means also fetch link headers for pagination. +NO-REPLIES means to exlude replies. +ONLY-MEDIA means show only posts containing attachments. +TAG is a hashtag to restrict posts to. +MAX-ID is a flag to include the max_id pagination parameter. +SKIP-PINNED means don't display pinned toots." + (let-alist account + (let* ((max-id-str (when max-id + (mastodon-tl--buffer-property 'max-id))) + (args `(("limit" . ,mastodon-tl--timeline-posts-count) + ,(when max-id `("max_id" . ,max-id-str)))) + (args (cond (no-reblogs + (push '("exclude_reblogs" . "t") args)) + (no-replies + (push '("exclude_replies" . "t") args)) + (only-media + (push '("only_media" . "t") args)) + (tag + (push `("tagged" . ,tag) args)) + (t args))) + (endpoint (format "accounts/%s/%s" .id endpoint-type)) + (url (mastodon-http--api endpoint)) + (buffer (concat "*mastodon-" .acct "-" + (concat endpoint-type + (cond (no-reblogs "-no-boosts") + (no-replies "-no-replies") + (only-media "-only-media") + (tag (format "-tagged-%s" tag)) + (t ""))) + "*")) + (response (if headers + (mastodon-http--get-response url args) + (mastodon-http--get-json url args))) + (json (if headers (car response) response)) + (link-header (when headers + (mastodon-tl--get-link-header-from-response + (cdr response)))) + (fields (mastodon-profile--fields-get account)) + (pinned (mastodon-profile--get-statuses-pinned account)) + (relationships (mastodon-profile--relationships-get .id))) + (with-mastodon-buffer buffer #'mastodon-mode nil + (mastodon-profile-mode) + (setq mastodon-profile--account account) + (mastodon-tl--set-buffer-spec buffer endpoint update-function + link-header args nil max-id-str) + (let* ((inhibit-read-only t)) + (insert + (propertize + (concat + "\n" + (mastodon-profile--image-from-account account 'avatar_static) + (mastodon-profile--image-from-account account 'header_static) + "\n" + (when .display_name + (propertize (if (string-empty-p .display_name) + .username + .display_name) + 'face 'mastodon-display-name-face)) + ;; roles + (when .roles + (concat " " (mastodon-profile--render-roles .roles))) + "\n" + (propertize (concat "@" .acct) 'face 'default) + (when (eq .locked t) + (concat " " (mastodon-tl--symbol 'locked))) + "\n " mastodon-tl--horiz-bar "\n" + ;; migration: + (when .moved + (mastodon-profile--render-moved .moved)) + ;; profile note: + (mastodon-tl--render-text .note account) ; account = tab-stops in profile + "\n") + 'profile-json account)) + ;; Joined date: + (mastodon-profile--insert-joined .created_at) + ;; meta fields: + (when fields + (mastodon-profile--format-fields fields)) + ;; insert counts + (mastodon-profile--insert-counts .statuses_count + .followers_count .following_count) + ;; insert relationship (follows) + (mastodon-profile--insert-relationships relationships) + (mastodon-media--inline-images (point-min) (point)) + ;; widget items description + (mastodon-widget--create + "View" (mastodon-profile--view-types) + (or (mastodon-profile--current-view-type + endpoint-type no-reblogs no-replies only-media tag) + 'statuses) + (lambda (widget &rest _ignore) + (let ((value (widget-value widget))) + (funcall + (alist-get value + mastodon-profile--account-view-alist))))) + (insert "\n") + (setq mastodon-tl--update-point (point)))) + ;; split insert of items from insert of profile: + (with-current-buffer buffer + (let* ((inhibit-read-only t)) + ;; insert pinned toots first + (when (and (not skip-pinned) + pinned + (string= endpoint-type "statuses")) + (let ((beg (point))) + (mastodon-profile--insert-statuses-pinned pinned) + (setq mastodon-tl--update-point (point)) + (mastodon-media--inline-images beg (point)))) ; updates after pinned toots + ;; insert items + (funcall update-function json) + (goto-char (point-min)) + (message + (substitute-command-keys + ;; "\\[mastodon-profile-account-view-cycle]" ; not always bound? + "\\`C-c C-c' to cycle profile views: toots, no replies, no boosts,\ + only media, followers, following. +\\`C-c C-s' to search user's toots, \\`C-c \#' to search user's posts for a hashtag."))))))) + +(defun mastodon-profile--current-view-type (type no-reblogs no-replies + only-media tag) + "Return the type of current profile view. +Return a member of `mastodon-profile--view-types', based on TYPE, +NO-REBLOGS, NO-REPLIES, ONLY-MEDIA and TAG." + (cond (no-reblogs 'no-boosts) + (no-replies 'no-replies) + (only-media 'only-media) + (tag 'tag) + (t (if (stringp type) (intern type) type)))) + +(defun mastodon-profile--format-joined-date-string (joined) + "Format a human-readable Joined string from timestamp JOINED. +JOINED is the `created_at' field in profile account JSON, and of +the format \"2000-01-31T00:00:00.000Z\"." + (format-time-string "%d %B %Y" + (parse-iso8601-time-string joined))) + +(defun mastodon-profile-get-toot-author (&optional max-id) + "Open profile of author of toot under point. +If toot is a boost, load the profile of the author of the original item. +MAX-ID is a flag to include the max_id pagination parameter." + (interactive) + (mastodon-tl--do-if-item + (let ((json (mastodon-tl--toot-or-base + (mastodon-profile--item-json)))) + (mastodon-profile--make-author-buffer + (alist-get 'account json) + nil nil nil nil max-id)))) + +(defun mastodon-profile--image-from-account (account img-type) + "Return a avatar image from ACCOUNT. +IMG-TYPE is the JSON key from the account data." + (let ((img (alist-get img-type account))) + (unless (string= img "/avatars/original/missing.png") + (mastodon-media--get-media-link-rendering img)))) + +(defun mastodon-profile-show-user (user-handle) + "Query for USER-HANDLE from current status and show that user's profile." + (interactive + (list + (if (and (not (mastodon-tl--profile-buffer-p)) + (not (mastodon-tl--property 'item-json :no-move))) + (user-error "Looks like there's no toot or user at point?") + (mastodon-tl-read-handle-annotated + (mastodon-profile--extract-users-handles (mastodon-profile--item-json)) + "View profile of user [choose or enter any handle]: ")))) + (if (not (or ; own profile has no need for item-json test: + (string= user-handle (mastodon-auth--get-account-name)) + (mastodon-tl--profile-buffer-p) + (mastodon-tl--property 'item-json :no-move))) + (user-error "Looks like there's no toot or user at point?") + (let ((account (mastodon-profile--lookup-account-in-status + user-handle (mastodon-profile--item-json)))) + (if (not account) + (user-error "Cannot find a user with handle %S" user-handle) + (progn + (message "Loading profile of user %s..." user-handle) + (mastodon-profile--make-author-buffer account)))))) + +(defun mastodon-profile-my-profile () + "Show the profile of the currently signed in user." + (interactive) + (message "Loading your profile...") + (let ((account (mastodon-profile--account-from-id + (mastodon-auth--get-account-id)))) + (mastodon-profile--make-author-buffer account))) + +(defun mastodon-profile--format-user (tootv) + "Convert TOOTV into author-bylines and insert. +Also insert their profile note. +Used to view a user's followers and those they're following." + (let ((inhibit-read-only t)) + (unless (seq-empty-p tootv) + (mapc + (lambda (toot) + (let ((start-pos (point))) + (insert + "\n" + (propertize + (mastodon-tl--byline-author `((account . ,toot)) :avatar nil :base) + 'byline 't + 'item-id (alist-get 'id toot) + 'base-item-id (mastodon-tl--item-id toot) + 'item-json toot)) + (mastodon-media--inline-images start-pos (point)) + (insert "\n" + (propertize + (mastodon-tl--render-text (alist-get 'note toot) nil) + 'item-json toot) + "\n"))) + tootv)))) + +(defun mastodon-profile--search-account-by-handle (handle) + "Return an account based on a user's HANDLE. +If the handle does not match a search return then retun NIL." + (let* ((handle (if (string= "@" (substring handle 0 1)) + (substring handle 1 (length handle)) + handle)) + (args `(("q" . ,handle) + ("type" . "accounts"))) + (result (mastodon-http--get-json + (mastodon-http--api-v2 "search") args)) + (matching-account (seq-remove + (lambda (x) + (not (string= handle (alist-get 'acct x)))) + (alist-get 'accounts result)))) + (when (eq 1 (length matching-account)) + (elt matching-account 0)))) + +(defun mastodon-profile--account-from-id (user-id) + "Request an account object relating to a USER-ID." + (mastodon-http--get-json + (mastodon-http--api (format "accounts/%s" user-id)))) + +(defun mastodon-profile--extract-users-handles (status) + "Return all user handles found in STATUS. +These include the author, author of reblogged entries and any user mentioned." + (when status + (let ((this-account (or (alist-get 'account status) ; status is a toot/notif + status)) ; status is a user listing + (mentions (mastodon-tl--field-status 'mentions status)) + (reblog (mastodon-tl--field-status 'reblog status)) + (grouped (when mastodon-group-notifications + ;; NB: looks like this only contains the grouped + ;; notifs for the current notif, which is not + ;; necessariliy all favers/boosters for a given item: + (let ((accounts (mastodon-tl--property 'notification-accounts + :nomove))) + (cl-loop for x in accounts + collect (alist-get 'acct x)))))) + (seq-remove + (lambda (x) (string= x mastodon-active-user)) + (seq-filter #'stringp + (seq-uniq + (seq-concatenate + 'list + (list (alist-get 'acct this-account)) + grouped + (when reblog (mastodon-profile--extract-users-handles reblog)) + (mastodon-tl--map-alist 'acct mentions)))))))) + +(defun mastodon-profile--lookup-account-in-status (handle status) + "Return account for HANDLE using hints in STATUS if possible." + (let* ((this-account (alist-get 'account status)) + (reblog-account (alist-get 'account (alist-get 'reblog status))) + (mention-id (seq-some + (lambda (mention) + (when (string= handle (alist-get 'acct mention)) + (alist-get 'id mention))) + (alist-get 'mentions status)))) + (cond ((string= handle (alist-get 'acct this-account)) + this-account) + ((string= handle (alist-get 'acct reblog-account)) + reblog-account) + (mention-id + (mastodon-profile--account-from-id mention-id)) + (t + (mastodon-profile--search-account-by-handle handle))))) + +;;; REMOVE + +(defun mastodon-profile-remove-user-from-followers (&optional id) + "Remove a user from your followers. +Optionally provide the ID of the account to remove." + (interactive) + (let* ((account (unless id (mastodon-tl--property 'item-json :no-move))) + (id (or id (alist-get 'id account))) + (handle (let ((account (or account + (mastodon-profile--account-from-id id)))) + (alist-get 'acct account))) + (url (mastodon-http--api + (format "accounts/%s/remove_from_followers" id)))) + (when (y-or-n-p (format "Remove follower %s? " handle)) + (let ((response (mastodon-http--post url))) + (mastodon-http--triage response + (lambda (_) + (message "Follower %s removed!" handle))))))) + +(defun mastodon-profile-remove-from-followers-at-point () + "Prompt for a user in the item at point and remove from followers." + (interactive) + (let* ((handles (mastodon-profile--extract-users-handles + (mastodon-profile--item-json))) + (handle (completing-read "Remove from followers: " handles)) + (account (mastodon-profile--lookup-account-in-status + handle (mastodon-profile--item-json))) + (id (alist-get 'id account))) + (mastodon-profile-remove-user-from-followers id))) + +(defun mastodon-profile-remove-from-followers-list () + "Select a user from your followers and remove from followers. +Currently limited to 100 handles. If not found, try +`mastodon-search-query'." + (interactive) + (let* ((endpoint (format "accounts/%s/followers" + (mastodon-auth--get-account-id))) + (url (mastodon-http--api endpoint)) + (response (mastodon-http--get-json url `(("limit" . "100")))) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id response)) + (choice (completing-read "Remove from followers: " handles)) + (id (alist-get choice handles))) + (mastodon-profile-remove-user-from-followers id))) + +;;; PRIVATE NOTES + +(defun mastodon-profile-add-private-note-to-account () + "Add a private note to an account. +Can be called from a profile page or normal timeline. +Send an empty note to clear an existing one." + (interactive) + (mastodon-profile--add-or-view-private-note + 'mastodon-profile--post-private-note-to-account + "add a note to")) + +(defun mastodon-profile--post-private-note-to-account (id handle note-old) + "POST a private note onto an account ID with user HANDLE on the server. +NOTE-OLD is the text of any existing note." + (let* ((note (read-string + (format "Add private note to account %s: " handle) + note-old)) + (params `(("comment" . ,note))) + (url (mastodon-http--api (format "accounts/%s/note" id))) + (response (mastodon-http--post url params))) + (mastodon-http--triage response + (lambda (_) + (message "Private note on %s added!" handle))))) + +(defun mastodon-profile-view-account-private-note () + "Display the private note about a user." + (interactive) + (mastodon-profile--add-or-view-private-note + 'mastodon-profile--display-private-note + "view private note of" + :view)) + +(defun mastodon-profile--display-private-note (note) + "Display private NOTE in a temporary buffer." + (with-output-to-temp-buffer "*mastodon-profile-private-note*" + (let ((inhibit-read-only t)) + (princ note)))) + +(defun mastodon-profile--profile-json () + "Return the profile-json property if we are in a profile buffer." + (if (not (mastodon-tl--profile-buffer-p)) + (error "Not viewing a profile") + (save-excursion + (goto-char (point-min)) + (or (mastodon-tl--property 'profile-json :no-move) + (error "No profile data found"))))) + +(defun mastodon-profile--add-or-view-private-note (action-fun + &optional message view) + "Add or view a private note for an account. +ACTION-FUN does the adding or viewing, MESSAGE is a prompt for +`mastodon-tl--user-handles-get', VIEW is a flag." + (let* ((profile-json (mastodon-profile--profile-json)) + (handle (if (mastodon-tl--profile-buffer-p) + (alist-get 'acct profile-json) + (mastodon-tl--user-handles-get message))) + (account (if (mastodon-tl--profile-buffer-p) + profile-json + (mastodon-profile--search-account-by-handle handle))) + (id (alist-get 'id account)) + (relationships (mastodon-profile--relationships-get id)) + (note (alist-get 'note relationships))) + (if view + (if (string-empty-p note) + (user-error "No private note for %s" handle) + ;; `mastodon-profile--display-private-note' takes 1 arg: + (funcall action-fun note)) + ;; `mastodon-profile--post-private-note-to-account' takes 3 args: + (funcall action-fun id handle note)))) + +;;; FAMILIAR FOLLOWERS + +(defun mastodon-profile-show-familiar-followers () + "Show a list of familiar followers. +Familiar followers are accounts that you follow, and that follow +the given account." + (interactive) + (let* ((profile-json (mastodon-profile--profile-json)) + (handle + (if (mastodon-tl--profile-buffer-p) + (alist-get 'acct profile-json) + (mastodon-tl--user-handles-get "show familiar followers of"))) + (account (if (mastodon-tl--profile-buffer-p) + profile-json + (mastodon-profile--search-account-by-handle handle))) + (id (alist-get 'id account))) + (mastodon-profile--get-familiar-followers id))) + +(defun mastodon-profile--get-familiar-followers (id) + "Return JSON data of familiar followers for account ID." + ;; the server handles multiple IDs, but we just handle one. + (let* ((params `(("id" . ,id))) + (url (mastodon-http--api "accounts/familiar_followers")) + (json (mastodon-http--get-json url params)) + (accounts (alist-get 'accounts (car json))) ; first id + (handles (mastodon-tl--map-alist 'acct accounts))) + (if (null handles) + (user-error "Looks like there are no familiar followers for this account") + (let ((choice (completing-read "Show profile of user: " handles))) + (mastodon-profile-show-user choice))))) + +;;; FEATURED TAGS + +(defun mastodon-profile-feature-tag () + "Feature a tag on your profile." + (interactive) + (let* ((tag (read-string "Feature tag on your profile: ")) + (endpoint (mastodon-http--api + (format "/tags/%s/feature" tag))) + (resp (mastodon-http--post endpoint))) + (mastodon-http--triage + resp (lambda (_resp) + (message "Tag #%s featured!" tag))))) + +(defun mastodon-profile--get-featured-tags (id) + "Get featured tags for user ID." + (let ((endpoint (mastodon-http--api + (format "/accounts/%s/featured_tags" id)))) + (mastodon-http--get-json endpoint))) + +(defun mastodon-profile-load-featured-tag () + "Prompt for a featured tag, and load posts containing it. +Only works when viewing a user's profile." + (interactive) + (let* ((data (mastodon-profile--profile-json)) + (id (alist-get 'id data)) + (tags (mastodon-profile--get-featured-tags id)) + (choice (completing-read "View user's featured tag: " + (mastodon-tl--map-alist 'name tags)))) + (mastodon-profile-open-statuses-tagged choice))) + +(defun mastodon-profile-own-featured-tags () + "Display your own featured tags. +Load a timeline of your own featured tags with +`mastodon-profile-load-featured-tag'when viewing your profile." + (interactive) + ;; GET /api/v1/featured_tags + (let* ((endpoint (mastodon-http--api "featured_tags")) + (tags (mastodon-http--get-json endpoint))) + (message "%S" + (mastodon-tl--map-alist 'name tags)))) + +(provide 'mastodon-profile) +;;; mastodon-profile.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-search.el b/elpa/mastodon-20260406.856/mastodon-search.el new file mode 100644 index 00000000..dda71765 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-search.el @@ -0,0 +1,390 @@ +;;; mastodon-search.el --- Search functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017-2019 Marty Hiatt +;; Author: Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; 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 "" .url "\n" .title) + link) + 'item-type 'link + 'item-json link + 'shr-url .url + 'byline t ;; nav + 'help-echo + (substitute-command-keys + "\\[`mastodon-search-load-link-posts'] to view a link's timeline")) + ;; TODO: display card link author here + "\n\n"))) + +(defun mastodon-search-load-link-posts () + "Load timeline of posts containing link at point." + (interactive) + (let* ((url (mastodon-tl--property 'shr-url))) + (mastodon-tl--link-timeline url))) + +(defun mastodon-search--view-trending (type print-fun) + "Display a list of tags trending on your instance. +TYPE is a string, either tags, statuses, or links. +PRINT-FUN is the function used to print the data from the response." + (let* ((url (mastodon-http--api (format "trends/%s" type))) + ;; max for statuses = 40, for others = 20 + (limit (if (string= type "statuses") + '("limit" . "40") + '("limit" . "20"))) + (offset '(("offset" . "0"))) + (params (push limit offset)) + (data (mastodon-http--get-json url params)) + (buffer (get-buffer-create + (format "*mastodon-trending-%s*" type)))) + (with-mastodon-buffer buffer #'mastodon-mode nil + (mastodon-tl--set-buffer-spec (buffer-name buffer) + (format "trends/%s" type) + print-fun nil params) + (mastodon-search--insert-heading "trending" type) + (funcall print-fun data) + (unless (string= type "statuses") + (goto-char (point-min)))))) + +;; functions for mastodon search + +(defun mastodon-search--insert-heading (str &optional type) + "Insert STR as a heading. +Optionally add string TYPE after HEADING." + (insert + (mastodon-search--format-heading str type))) + +(defun mastodon-search--format-heading (str &optional type no-newline) + "Format STR as a heading. +Optionally add string TYPE after HEADING. +NO-NEWLINE means don't add add a newline at end." + (mastodon-tl--set-face + (concat "\n " mastodon-tl--horiz-bar "\n " + (upcase str) " " + (when type (upcase type)) "\n" + " " mastodon-tl--horiz-bar (unless no-newline "\n")) + 'success)) + +(defvar mastodon-search-types + '("statuses" "accounts" "hashtags")) + +(defun mastodon-search-query (query &optional type limit + following account-id offset) + "Prompt for a search QUERY and return accounts, statuses, and hashtags. +TYPE is a member of `mastodon-search-types'. +LIMIT is a number as string, up to 40, with 40 the default. +FOLLOWING means limit to accounts followed, for \"accounts\" type only. +A single prefix arg also sets FOLLOWING to true. +ACCOUNT-ID means limit search to that account, for \"statuses\" type only. +OFFSET is a number as string, means to skip that many results. It +is used for pagination." + ;; TODO: handle no results + (interactive "sSearch mastodon for: ") + (let* ((url (mastodon-http--api-v2 "search")) + (following (when (or following (equal current-prefix-arg '(4))) + "true")) + (type (or type + (if (equal current-prefix-arg '(4)) + "accounts" ; if FOLLOWING, must be "accounts" + (completing-read "Search type: " + mastodon-search-types nil :match)))) + (limit (or limit "40")) + (offset (or offset "0")) + (buffer (format "*mastodon-search-%s-%s*" type query)) + (params `(("q" . ,query) + ,@(when type `(("type" . ,type))) + ,@(when limit `(("limit" . ,limit))) + ,@(when offset `(("offset" . ,offset))) + ,@(when following `(("following" . ,following))) + ,@(when account-id `(("account_id" . ,account-id))))) + (response (mastodon-http--get-json url params)) + (items (alist-get (intern type) response))) + (with-mastodon-buffer buffer #'mastodon-mode nil + (mastodon-search-mode) + (mastodon-search--insert-heading "search") + (mastodon-widget--create + "Results" + '(accounts hashtags statuses) + (intern type) + (lambda (widget &rest _ignore) + (let ((value (widget-value widget))) + (mastodon-search-query query (symbol-name value))))) + (insert "\n\n") + (cond ((string= type "accounts") + (mastodon-search--render-response items type buffer params + 'mastodon-views--insert-users-propertized-note + 'mastodon-views--insert-users-propertized-note)) + ((string= type "hashtags") + (mastodon-search--render-response items type buffer params + 'mastodon-search--print-tags + 'mastodon-search--print-tags)) + ((string= type "statuses") + (mastodon-search--render-response items type buffer params + #'mastodon-tl--timeline + #'mastodon-tl--timeline))) + (goto-char (point-min)) + (message + (substitute-command-keys + "\\[mastodon-search-query-cycle] to cycle result types."))))) + +(defun mastodon-search-insert-no-results (&optional thing) + "Insert a no results message for object THING." + (let ((thing (or thing "items"))) + (insert + (propertize (format "Looks like search returned no %s." thing) + 'face 'mastodon-toot-docs-face)))) + +(defun mastodon-search--render-response (data type buffer params + insert-fun update-fun) + "Call INSERT-FUN on DATA of result TYPE if non-nil. +BUFFER, PARAMS, and UPDATE-FUN are for `mastodon-tl--buffer-spec'." + (if (not data) + (mastodon-search-insert-no-results type) + (funcall insert-fun data)) + (mastodon-tl--set-buffer-spec buffer "search" + update-fun nil params)) + +(defun mastodon-search--buf-type () + "Return search buffer type, a member of `mastodon-search-types'." + ;; called in `mastodon-tl--get-buffer-type' + (let* ((spec (mastodon-tl--buffer-property 'update-params))) + (alist-get "type" spec nil nil #'string=))) + +(defun mastodon-search-query-cycle () + "Cycle through search types: accounts, hashtags, and statuses." + (interactive) + (let* ((spec (mastodon-tl--buffer-property 'update-params)) + (type (alist-get "type" spec nil nil #'string=)) + (query (alist-get "q" spec nil nil #'string=))) + (cond ((string= type "hashtags") + (mastodon-search-query query "accounts")) + ((string= type "accounts") + (mastodon-search-query query "statuses")) + ((string= type "statuses") + (mastodon-search-query query "hashtags"))))) + +(defun mastodon-search-query-accounts-followed (query) + "Run an accounts search QUERY, limited to your followers." + (interactive "sSearch mastodon for: ") + (mastodon-search-query query "accounts" :following)) + +(defun mastodon-search--insert-users-propertized (json &optional note) + "Insert users list into the buffer. +JSON is the data from the server. +If NOTE is non-nil, include user's profile note. This is also + called by `mastodon-tl--get-follow-suggestions' and + `mastodon-profile--insert-follow-requests'." + (cl-loop for acct in json + do (insert (concat (mastodon-search--propertize-user acct note) + mastodon-tl--horiz-bar + "\n\n")))) + +(defun mastodon-search--propertize-user (acct &optional note) + "Propertize display string for ACCT, optionally including profile NOTE." + (let* ((user (mastodon-search--get-user-info acct)) + (id (alist-get 'id acct))) + (propertize + (concat + (propertize (car user) + 'face 'mastodon-display-name-face + 'byline t + 'item-type 'user + 'item-id id) ; for prev/next nav + " : \n : " + (propertize (concat "@" (cadr user)) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + 'mastodon-tab-stop 'user-handle + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" (cadr user)) + 'help-echo (concat "Browse user profile of @" (cadr user))) + " : \n" + (when note + (mastodon-tl--render-text (cadddr user) acct)) + "\n") + 'item-json acct))) ; for compat w other processing functions + +(defun mastodon-search--print-tags (tags) + "Print TAGS data as returned from a \"hashtags\" search query." + (let ((tags-list (mapcar #'mastodon-search--get-hashtag-info tags))) + (mastodon-search--print-tags-list tags-list))) + +(defun mastodon-search--print-tags-list (tags-list) + "Insert a propertized list of TAGS-LIST." + (cl-loop for el in tags-list + do (insert + " : " + (propertize (concat "#" (car el)) + 'face '(:box t) + 'mouse-face 'highlight + 'mastodon-tag (car el) + 'mastodon-tab-stop 'hashtag + 'item-type 'tag ; for next/prev nav + 'byline t ; for next/prev nav + 'help-echo (concat "Browse tag #" (car el)) + 'keymap mastodon-tl--link-keymap) + " : \n\n"))) + +(defun mastodon-search--get-user-info (account) + "Get user handle, display name, account URL and profile note from ACCOUNT." + (list (mastodon-tl--display-or-uname account) + (alist-get 'acct account) + (alist-get 'url account) + (alist-get 'note account))) + +(defun mastodon-search--get-hashtag-info (tag) + "Get hashtag name and URL from TAG." + (list (alist-get 'name tag) + (alist-get 'url tag))) + +;; These functions are all unused! + +;; (defun mastodon-search--get-status-info (status) +;; "Get ID, timestamp, content, and spoiler from STATUS." +;; (list (alist-get 'id status) +;; (alist-get 'created_at status) +;; (alist-get 'spoiler_text status) +;; (alist-get 'content status))) + +;; (defun mastodon-search--id-from-status (status) +;; "Fetch the id from a STATUS returned by a search call to the server. +;; We use this to fetch the complete status from the server." +;; (alist-get 'id status)) + +;; (defun mastodon-search--full-status-from-id (id) +;; "Fetch the full status with id ID from the server. +;; This allows us to access the full account etc. details and to +;; render them properly." +;; (let* ((url (mastodon-http--api (format "statuses/%s" id))) +;; ;; (concat mastodon-instance-url "/api/v1/statuses/" +;; ;; (mastodon-tl--as-string id))) +;; (json (mastodon-http--get-json url))) +;; json)) + +(defvar mastodon-search-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'mastodon-search-query-cycle) + map) + "Keymap for `mastodon-search-mode'.") + +(define-minor-mode mastodon-search-mode + "Toggle mastodon search minor mode. +This minor mode is used for mastodon search pages to adds a keybinding." + :init-value nil + :lighter " Search" + :keymap mastodon-search-mode-map + :group 'mastodon + :global nil) + +(provide 'mastodon-search) +;;; mastodon-search.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-tl.el b/elpa/mastodon-20260406.856/mastodon-tl.el new file mode 100644 index 00000000..b331bcd2 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-tl.el @@ -0,0 +1,4141 @@ +;;; 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 +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-tl.el provides timeline functions. + +;;; Code: + +(require 'shr) +(require 'thingatpt) ; for word-at-point +(require 'time-date) +(require 'cl-lib) +(require 'mastodon-iso) +(require 'mpv nil :no-error) +(require 'url-cache) + +(autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-notifications-get "mastodon") +(autoload 'mastodon-url-lookup "mastodon") +(autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-auth--get-account-name "mastodon-auth") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--build-params-string "mastodon-http") +(autoload 'mastodon-http--delete "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-http--get-response-async "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-media--get-avatar-rendering "mastodon-media") +(autoload 'mastodon-media--get-media-link-rendering "mastodon-media") +(autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-notifications--filter-types-list "mastodon-notifications") +(autoload 'mastodon-notifications-get-mentions "mastodon-notifications") +(autoload 'mastodon-profile--account-from-id "mastodon-profile") +(autoload 'mastodon-profile--extract-users-handles "mastodon-profile") +(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-profile-get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile-my-profile "mastodon-profile") +(autoload 'mastodon-profile-open-statuses-no-reblogs "mastodon-profile") +(autoload 'mastodon-profile--profile-json "mastodon-profile") +(autoload 'mastodon-profile--search-account-by-handle "mastodon-profile") +(autoload 'mastodon-profile--item-json "mastodon-profile") +(autoload 'mastodon-profile--view-author-profile "mastodon-profile") +(autoload 'mastodon-profile-mode "mastodon-profile") +(autoload 'mastodon-search--get-user-info "mastodon-search") +(autoload 'mastodon-search--insert-users-propertized "mastodon-search") +(autoload 'mastodon-search--propertize-user "mastodon-search") +(autoload 'mastodon-toot--compose-buffer "mastodon-toot") +(autoload 'mastodon-toot-delete-toot "mastodon-toot") +(autoload 'mastodon-toot--get-toot-edits "mastodon-toot") +(autoload 'mastodon-toot--iso-to-human "mastodon-toot") +(autoload 'mastodon-toot-schedule-toot "mastodon-toot") +(autoload 'mastodon-toot--set-toot-properties "mastodon-toot") +(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-search--buf-type "mastodon-search") +(autoload 'mastodon-views--insert-users-propertized-note "mastodon-views") ; for search pagination +(autoload 'mastodon-http--get-response "mastodon-http") +(autoload 'mastodon-search--insert-heading "mastodon-search") +(autoload 'mastodon-media--process-full-sized-image-response "mastodon-media") +(autoload 'mastodon-search-trending-statuses "mastodon-search") +(autoload 'mastodon-search--format-heading "mastodon-search") +(autoload 'mastodon-media--image-or-cached "mastodon-media") +(autoload 'mastodon-toot--base-toot-or-item-json "mastodon-toot") +(autoload 'mastodon-search-load-link-posts "mastodon-search") +(autoload 'mastodon-notifications--current-type "mastodon-notifications") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") +(autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications") +(autoload 'mastodon-search--print-tags "mastodon-search") +(autoload 'mastodon-profile-show-user "mastodon-profile") +(autoload 'mastodon-toot--own-toot-p "mastodon-toot") + +(defvar mastodon-toot--visibility) +(defvar mastodon-toot-mode) +(defvar mastodon-active-user) +(defvar mastodon-images-in-notifs) +(defvar mastodon-group-notifications) +(defvar mastodon-profiles-quote-policy-types) + +(when (require 'mpv nil :no-error) + (declare-function mpv-start "mpv")) +(defvar mastodon-mode-map) +(defvar mastodon-instance-url) +(defvar mastodon-toot-timestamp-format) +(defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this +(defvar mastodon-media--enable-image-caching) +(defvar mastodon-media--generic-broken-image-data) +(defvar mastodon-media--sensitive-image-data) +(defvar mastodon-media--attachments) + + +;;; CUSTOMIZES + +(defgroup mastodon-tl nil + "Timelines in Mastodon." + :prefix "mastodon-tl-" + :group 'mastodon) + +(defcustom mastodon-tl--enable-relative-timestamps t + "Whether to show relative (to the current time) timestamps. +This will require periodic updates of a timeline buffer to +keep the timestamps current as time progresses." + :type '(boolean :tag "Enable relative timestamps and background updater task")) + +(defcustom mastodon-tl--enable-proportional-fonts nil + "Nonnil to enable using proportional fonts when rendering HTML. +By default fixed width fonts are used." + :type '(boolean :tag "Enable using proportional rather than fixed \ +width fonts when rendering HTML text")) + +(defcustom mastodon-tl--no-fill-on-render nil + "Non-nil to disable filling by shr.el while rendering toot body. +Use this if your setup isn't compatible with shr's window width filling." + :type '(boolean)) + +(defcustom mastodon-tl--display-media-p t + "A boolean value stating whether to show media in timelines." + :type 'boolean) + +(defcustom mastodon-tl--display-caption-not-url-when-no-media t + "Display an image's caption rather than URL. +Only has an effect when `mastodon-tl--display-media-p' is set to +nil." + :type 'boolean) + +(defcustom mastodon-tl--show-avatars nil + "Whether to enable display of user avatars in timelines." + :type '(boolean :tag "Whether to display user avatars in timelines")) + +(defcustom mastodon-tl--show-stats t + "Whether to show toot stats (faves, boosts, replies counts)." + :type 'boolean) + +(defcustom mastodon-tl--symbols + `((reply . ("💬" . "R")) + (boost . ("🔁" . "B")) + (reblog . ("🔁" . "B")) ;; server compat + (favourite . ("⭐" . "F")) + (bookmark . ("🔖" . "K")) + (media . ("📹" . "[media]")) + (verified . ("✓" . "V")) + (locked . ("🔒" . "[locked]")) + (private . ("🔒" . "[followers]")) + (mention . ("@" . "[mention]")) + (direct . ("✉" . "[direct]")) + (edited . ("✍" . "[edited]")) + (update . ("✍" . "[edited]")) ;; server compat + (status . ("🔔" . "[posted]")) + (replied . ("⬇" . "↓")) + (reply-bar . ("┃" . "|")) + (poll . ("📊" . "[poll]")) + (follow . ("👤" . "+")) + (follow_request . ("👤" . "+")) + (severed_relationships . ("🔗" . "//")) + (moderation_warning . ("⚠" . "!!")) + (bot . ("🤖" . "[bot]")) + (quote . (,(propertize "“" 'face + '(t :inherit success :weight bold + :height 1.8)))) + (quoted_update . ("✍" . "[edited]"))) + "A set of symbols (and fallback strings) to be used in timeline. +If a symbol does not look right (tofu), it means your +font settings do not support it." + :type '(alist :key-type symbol :value-type (cons string string))) + +(defcustom mastodon-tl-position-after-update nil + "Defines where `point' should be located after a timeline update. +Valid values are: +- nil Top/bottom depending on timeline type +- keep-point Keep original position of point +- last-old-toot The last toot before the new ones" + :type '(choice (const :tag "Top/bottom depending on timeline type" nil) + (const :tag "Keep original position of point" keep-point) + (const :tag "The last toot before the new ones" last-old-toot))) + +(defcustom mastodon-tl--timeline-posts-count "20" + "Number of posts to display when loading a timeline. +Must be an integer between 20 and 40 inclusive." + :type '(string)) + +(defcustom mastodon-tl--hide-replies nil + "Whether to hide replies from the timelines. +Note that you can hide replies on a one-off basis by loading a +timeline with a simple prefix argument, `C-u'." + :type '(boolean :tag "Whether to hide replies from the timelines.")) + +(defcustom mastodon-tl--highlight-current-toot nil + "Whether to highlight the toot at point. Uses `cursor-face' special property." + :type '(boolean)) + +(defcustom mastodon-tl--expand-content-warnings 'server + "Whether to expand content warnings by default. +The API returns data about this setting on the server, but no +means to set it, so we roll our own option here to override the +server setting if desired. If you change the server setting and +want it to be respected by mastodon.el, you'll likely need to +either unset `mastodon-profile-acccount-preferences-data' and +re-load mastodon.el, or restart Emacs." + :type '(choice (const :tag "true" t) + (const :tag "false" nil) + (const :tag "follow server setting" server))) + +(defcustom mastodon-tl--tag-timeline-tags nil + "A list of up to four tags for use with `mastodon-tl-followed-tags-timeline'." + :type '(repeat string)) + +(defcustom mastodon-tl--load-full-sized-images-in-emacs t + "Whether to load full-sized images inside Emacs. +Full-sized images are loaded when you hit return on or click on +an image in a timeline. +If nil, mastodon.el will instead call `shr-browse-image', which +respects the user's `browse-url' settings." + :type '(boolean)) + +(defcustom mastodon-tl--remote-local-domains nil + "A list of domains to view the local timelines of. +See `mastodon-tl-get-remote-local-timeline' for view remote local domains." + :type '(repeat string)) + +(defcustom mastodon-tl--fold-toots-at-length 1200 + "Length, in characters, to fold a toot at. +Longer toots will be folded and the remainder replaced by a +\"read more\" button. If the value is nil, don't fold at all." + :type '(integer)) + + +;;; 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 ?―) ?― ?-))) + + +;;; 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 "") #'mastodon-tl-mpv-play-video-at-point) + (define-key map (kbd "") #'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 "") #'mastodon-tl-mpv-play-video-from-byline) + (define-key map (kbd "RET") #'mastodon-profile-get-toot-author) + (define-key map (kbd "S") #'mastodon-tl-toggle-sensitive-image) + map)) + "The keymap to be set for the author byline. +It is active where point is placed by `mastodon-tl-goto-next-item.'") + +(require 'image-mode) + +(defvar mastodon-image-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map image-mode-map) + (define-key map (kbd ">") #'mastodon-tl-next-full-image) + (define-key map (kbd "<") #'mastodon-tl-prev-full-image) + (define-key map (kbd ".") #'mastodon-tl-next-full-image) + (define-key map (kbd ",") #'mastodon-tl-prev-full-image) + ;; matches view full image binding in main keymap: + (define-key map (kbd "=") #'mastodon-tl-next-full-image) + (define-key map (kbd "-") #'mastodon-tl-prev-full-image) + (define-key map (kbd "") #'mastodon-tl-next-full-image) + (define-key map (kbd "") #'mastodon-tl-prev-full-image) + map)) + + +;;; 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)) + + +;;; NAV + +(defun mastodon-tl-scroll-up-command () + "Call `scroll-up-command', loading more toots if necessary. +If we hit `point-max', call `mastodon-tl--more' then `scroll-up-command'." + (interactive) + (if (not (eq (point) (point-max))) + (scroll-up-command) + (mastodon-tl--more) + (scroll-up-command))) + +(defun mastodon-tl-next-tab-item (&optional previous) + "Move to the next interesting item. +This could be the next toot, link, or image; whichever comes first. +Don't move if nothing to move to is found, i.e. near the end of the buffer. +This also skips tab items in invisible text, i.e. hidden spoiler text. +PREVIOUS means move to previous item." + (interactive) + (let (next-range + (search-pos (point))) + (while (and (setq next-range + (mastodon-tl--find-next-or-previous-property-range + 'mastodon-tab-stop search-pos previous)) + (get-text-property (car next-range) 'invisible) + (setq search-pos (if previous + (1- (car next-range)) + (1+ (cdr next-range))))) + ;; do nothing, all the action is in the while condition + ) + (if (null next-range) + (user-error "Nothing else here") + (goto-char (car next-range)) + (message "%s" (mastodon-tl--property 'help-echo :no-move))))) + +(defun mastodon-tl-previous-tab-item () + "Move to the previous interesting item. +This could be the previous toot, link, or image; whichever comes +first. Don't move if nothing else to move to is found, i.e. near +the start of the buffer. This also skips tab items in invisible +text, i.e. hidden spoiler text." + (interactive) + (mastodon-tl-next-tab-item :previous)) + +(defun mastodon-tl--goto-item-pos (find-pos refresh &optional pos) + "Search for item with function FIND-POS. +If search returns nil, execute REFRESH function. +Optionally start from POS." + (let* ((npos ; toot/user items have byline: + (funcall find-pos + (or pos + (if (save-excursion + (when (not (= 1 (point))) + (backward-char 1)) + (looking-at "\u2068")) + (1- (point)) + (point))) + ;; FIXME: we need to fix item-type? + ;; 'item-type ; breaks nav to last item in a view? + 'byline + (current-buffer))) + (max-lisp-eval-depth 4)) ;; clamp down on endless loops + (if npos + (if (not (get-text-property npos 'item-type)) ; generic + ;; FIXME let's make refresh &optional and only call refresh/recur + ;; if non-nil: + (mastodon-tl--goto-item-pos find-pos refresh npos) + (goto-char npos) + ;; force display of help-echo on moving to a toot byline: + (mastodon-tl--message-help-echo) + (when (looking-at "\u2068") + (forward-char 1))) + (condition-case nil + (funcall refresh) + (error "No more items"))))) + +(defun mastodon-tl-goto-next-item (&optional no-refresh) + "Jump to next item. +Load more items it no next item. +NO-REFRESH means do no not try to load more items if no next item +found." + (interactive) + (condition-case nil + (mastodon-tl--goto-item-pos 'next-single-property-change + (unless no-refresh 'mastodon-tl--more)) + (t (error "No more items")))) + +(defun mastodon-tl-goto-prev-item (&optional no-refresh) + "Jump to previous item. +Update if no previous items. +NO-REFRESH means do no not try to load more items if no next item +found." + (interactive) + (condition-case nil + (mastodon-tl--goto-item-pos 'previous-single-property-change + (unless no-refresh 'mastodon-tl-update)) + (t (error "No more items")))) + +(defun mastodon-tl--goto-first-item () + "Jump to first toot or item in buffer. +Used on initializing a timeline or thread." + (goto-char (point-min)) + (condition-case nil + (mastodon-tl--goto-item-pos 'next-single-property-change + 'next-line) + (t (error "No item")))) + + +;;; TIMELINES + +(defun mastodon-tl-get-federated-timeline (&optional prefix local max-id) + "Open federated timeline. +If LOCAL, get only local timeline. +With a single PREFIX arg, hide-replies. +With a double PREFIX arg, only show posts with media." + (interactive "p") + (let ((params + `(("limit" . ,mastodon-tl--timeline-posts-count) + ,@(when (eq prefix 16) + '(("only_media" . "true"))) + ,@(when local + '(("local" . "true"))) + ,@(when max-id + `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))) + (message "Loading federated timeline...") + (mastodon-tl--init (if local "local" "federated") + "timelines/public" 'mastodon-tl--timeline nil + params + (when (eq prefix 4) t)))) + +(defun mastodon-tl-get-home-timeline (&optional arg max-id) + "Open home timeline. +With a single prefix ARG, hide replies. +MAX-ID is a flag to add the max_id pagination parameter." + (interactive "p") + (let* ((params + `(("limit" . ,mastodon-tl--timeline-posts-count) + ,@(when max-id + `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))))) + (message "Loading home timeline...") + (mastodon-tl--init "home" "timelines/home" 'mastodon-tl--timeline nil + params + (when (eq arg 4) t)))) + +(defun mastodon-tl-get-remote-local-timeline (&optional endpoint) + "Prompt for an instance domain and try to display its local timeline. +You can enter any working instance domain. Domains that you want +to regularly load can be stored in +`mastodon-tl--remote-local-domains' for easy access with completion. +Note that some instances do not make their local timelines public, in +which case this will not work. +To interact with any item, you must view it from your own +instance, which you can do with +`mastodon-tl-view-item-on-own-instance'. +Optionally, provide API ENDPOINT." + (interactive) + (let* ((domain (completing-read "Domain for remote local tl: " + mastodon-tl--remote-local-domains)) + (params `(("limit" . ,mastodon-tl--timeline-posts-count) + ("local" . "true"))) + (buf (concat "remote-local-" domain)) + (known (member domain + (mastodon-http--get-json + (mastodon-http--api "instance/peers"))))) + ;; condition-case doesn't work here, so i added basic error handling to + ;; `mastodon-tl--init*' instead + (when (or known + (y-or-n-p + "Domain appears unknown to your instance. Proceed?")) + (mastodon-tl--init buf + (or endpoint "timelines/public") + 'mastodon-tl--timeline nil + params nil domain)))) + +(defun mastodon-tl-remote-tag-timeline (&optional tag) + "Call `mastodon-tl-get-remote-local-timeline' but for a TAG timeline." + (interactive) + (let* ((tag (or tag (read-string "Tag: "))) + (endpoint (format "timelines/tag/%s" tag))) + (mastodon-tl-get-remote-local-timeline endpoint))) + +(defun mastodon-tl-view-item-on-own-instance () + "Load current toot on your own instance. +Use this to re-load remote-local items in order to interact with them." + (interactive) + (mastodon-tl--do-if-item + (let* ((toot (mastodon-tl--property 'item-json)) + (uri (mastodon-tl--field 'uri toot))) + (mastodon-url-lookup uri)))) + +(defun mastodon-tl-get-local-timeline (&optional prefix max-id) + "Open local timeline. +With a single PREFIX arg, hide-replies. +With a double PREFIX arg, only show posts with media. +MAX-ID is a flag to add the max_id pagination parameter." + (interactive "p") + (message "Loading local timeline...") + (mastodon-tl-get-federated-timeline prefix :local max-id)) + +(defun mastodon-tl-get-tag-timeline (&optional prefix tag) + "Prompt for tag and opens its timeline. +Optionally load TAG timeline directly. +With a single PREFIX arg, only show posts with media. +With a double PREFIX arg, limit results to your own instance." + (interactive "p") + (let* ((word (or (word-at-point) "")) + (input (or tag (read-string + (format "Load timeline for tag (%s): " word)))) + (tag (or tag (if (string-empty-p input) word input)))) + (message "Loading timeline for #%s..." tag) + (mastodon-tl--show-tag-timeline prefix tag))) + +(defun mastodon-tl--show-tag-timeline (&optional prefix tag) + "Opens a new buffer showing the timeline of posts with hastag TAG. +If TAG is a list, show a timeline for all tags. +With a single PREFIX arg, only show posts with media. +With a double PREFIX arg, limit results to your own instance." + (let ((params + `(("limit" . ,mastodon-tl--timeline-posts-count) + ,@(when (eq prefix 4) + '(("only_media" . "true"))) + ,@(when (eq prefix 16) + '(("local" . "true")))))) + (when (listp tag) + (let ((list (mastodon-http--build-array-params-alist "any[]" (cdr tag)))) + (while list + (push (pop list) params)))) + (mastodon-tl--init + (if (listp tag) "tags-multiple" (concat "tag-" tag)) + (concat "timelines/tag/" (if (listp tag) (car tag) tag)) ; must be /tag/:sth + 'mastodon-tl--timeline nil params))) + +(defun mastodon-tl--link-timeline (url) + "Load a link timeline, displaying posts containing URL." + (let ((params `(("url" . ,url)))) + (mastodon-tl--init "links" "timelines/link" + 'mastodon-tl--timeline nil + params))) + +(defun mastodon-tl-announcements () + "Display announcements from your instance." + (interactive) + (mastodon-tl--init "announcements" "announcements" + 'mastodon-tl--timeline nil nil nil nil :no-byline)) + + +;;; BYLINES, etc. + +(defun mastodon-tl--message-help-echo () + "Call message on `help-echo' property at point. +Do so if type of status at poins is not follow_request/follow." + (let ((type (alist-get 'type + (mastodon-tl--property 'item-json :no-move))) + (echo (mastodon-tl--property 'help-echo :no-move))) + (when (not (string= "" echo)) ; not for followers/following in profile + (unless (or (string= type "follow_request") + (string= type "follow")) ; no counts for these + (message "%s" echo))))) + +(defun mastodon-tl--unicode-wrap (str) + "Wrap STR in unicode directional isolates." + ;; see https://unicode.org/reports/tr9/#Explicit_Directional_Isolates + ;; via Tusky (again! thanks) + ;; https://codeberg.org/tusky/Tusky/src/commit/16cef3d6202648e4fd67f06ef0fb1d0a2d04b68f/app/src/main/java/com/keylesspalace/tusky/util/StringUtils.kt#L65 + (concat "\u2068" str "\u2069")) + +(defun mastodon-tl--byline-username (toot) + "Format a byline username from account in TOOT. +TOOT may be account data, or toot data, in which case acount data +is extracted from it." + (let ((data (or (alist-get 'account toot) + toot))) ;; grouped nofifs use account data directly + (let-alist data + (let ((disp (if (and .display_name + (not (string-empty-p .display_name))) + (mastodon-tl--unicode-wrap .display_name) + .username))) + (propertize disp + 'face 'mastodon-display-name-face + ;; enable playing of videos when point is on byline: + ;; 'attachments (mastodon-tl--get-attachments-for-byline toot) + 'keymap mastodon-tl--byline-link-keymap + ;; echo faves count when point on post author name: + ;; which is where --goto-next-toot puts point. + 'help-echo + ;; but don't add it to "following"/"follows" on + ;; profile views: we don't have a tl--buffer-spec + ;; yet: + (unless (or (string-suffix-p "-followers*" (buffer-name)) + (string-suffix-p "-following*" (buffer-name))) + (mastodon-tl--format-byline-help-echo data))))))) + +(defun mastodon-tl--byline-handle (toot &optional domain string face) + "Format a byline handle from account in TOOT. +DOMAIN is optionally added to the handle. +ACCOUNT is optionally acccount data to use. +STRING is optionally the string to propertize, it is used to make +username rather than handle buttons. +FACE is optionally the face to use. +The last two args allow for display a username as a clickable +handle." + (let-alist (or (alist-get 'account toot) + toot) ;; grouped notifs + (let ((str (or string + (concat "@" .acct + (when domain + (concat "@" + (url-host + (url-generic-parse-url .url)))))))) + (mastodon-tl--buttonify-link + (mastodon-tl--unicode-wrap str) + 'face (or face 'mastodon-handle-face) + 'mastodon-tab-stop 'user-handle + 'shr-url .url + 'mastodon-handle (concat "@" .acct) + 'help-echo (concat "Browse user profile of @" .acct))))) + +(defun mastodon-tl--byline-uname-+-handle (data &optional domain) + "Concatenate a byline username and handle. +DATA is the (toot) data to use. +DOMAIN is optionally a domain for the handle. +ACCOUNT is optionally acccount data to use." + (concat (mastodon-tl--byline-username data) + " (" (mastodon-tl--byline-handle data domain) ")")) + +(defun mastodon-tl--display-or-uname (account) + "Return display name or username from ACCOUNT data." + (if (not (string-empty-p (alist-get 'display_name account))) + (alist-get 'display_name account) + (alist-get 'username account))) + +(defun mastodon-tl--byline-author (toot &optional avatar domain base) + "Propertize author of TOOT. +With arg AVATAR, include the account's avatar image. +When DOMAIN, force inclusion of user's domain in their handle. +BASE means to use data from the base item (reblog slot) if possible. +If BASE is nil, we are a boosted byline, so show less info. +ACCOUNT is optionally acccount data to use." + (let* ((data (if base + (mastodon-tl--toot-or-base toot) + toot)) + (account (alist-get 'account data)) + (uname (mastodon-tl--display-or-uname account))) + (concat + ;; avatar insertion moved up to `mastodon-tl--byline' by default to + ;; be outside 'byline propt. + (when (and avatar ; used by `mastodon-profile--format-user' + mastodon-tl--show-avatars + mastodon-tl--display-media-p + (mastodon-tl--image-trans-check)) + (mastodon-media--get-avatar-rendering + (map-nested-elt data '(account avatar)))) + (if (not base) + ;; boost symbol: + (concat (mastodon-tl--symbol 'boost) + " " + ;; username as button: + (mastodon-tl--byline-handle + data domain + ;; display uname not handle (for boosts): + uname 'mastodon-display-name-face)) + ;; normal combo author byline: + (mastodon-tl--byline-uname-+-handle data domain))))) + +(defun mastodon-tl--format-byline-help-echo (toot) + "Format a help-echo for byline of TOOT. +Displays a toot's media types and optionally the binding to play +moving image media from the byline. +Used when point is at the start of a byline, i.e. where +`mastodon-tl-goto-next-item' leaves point." + (let* ((toot-to-count + (or ; simply praying this order works + (alist-get 'status toot) ; notifications timeline + ;; fol-req notif, has 'type placed before boosts coz fol-reqs have + ;; a (useless) reblog entry: + (when (and (or (mastodon-tl--buffer-type-eq 'notifications) + (mastodon-tl--buffer-type-eq 'mentions)) + (alist-get 'type toot)) + toot) + (alist-get 'reblog toot) ; boosts + toot)) ; everything else + (fol-req-p (let ((type (alist-get 'type toot-to-count))) + (or (string= type "follow") + (string= type "follow_request"))))) + (unless fol-req-p + (let* ((media-types (mastodon-tl--get-media-types toot)) + (format-media (when media-types + (format "media: %s" + (mapconcat #'identity media-types " ")))) + (format-media-binding (when (and (or (member "video" media-types) + (member "gifv" media-types)) + (require 'mpv nil :no-error)) + " | C-RET to view with mpv"))) + (concat format-media format-media-binding))))) + +(defun mastodon-tl--get-media-types (toot) + "Return a list of the media attachment types of the TOOT at point." + (let* ((attachments (mastodon-tl--field 'media_attachments toot))) + (mastodon-tl--map-alist 'type attachments))) + +(defun mastodon-tl--get-attachments-for-byline (toot) + "Return a list of attachment URLs and types for TOOT. +The result is added as an attachments property to author-byline." + (let ((media (mastodon-tl--field 'media_attachments toot))) + (mapcar (lambda (attachment) + (let-alist attachment + (list :id .id + :type .type + ;; fallback for notifications: + :url (or .remote_url .url)))) + media))) + +(defun mastodon-tl--acc-by-id (id) + "Return account JSON for ID." + (let* ((endpoint (format "accounts/%s" id)) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url))) + +(defun mastodon-tl--top-byline (toot) + "Format a boost or reply top (action) byline for TOOT. +If it is a self-reply, return \\='continued thread'. +If it is a non-self-reply, return \\='in reply to $username'. +If it is a boost, return \\='$username boosted'." + (let ((reblog (alist-get 'reblog toot)) + (reply-acc-id (alist-get 'in_reply_to_account_id toot))) + (cond + (reblog + (concat (mastodon-tl--byline-author toot) " " + (propertize "boosted" 'face 'mastodon-boosted-face) "\n")) + (reply-acc-id + (unless (mastodon-tl--buffer-type-eq 'thread) + (if (equal reply-acc-id (map-nested-elt toot '(account id))) + (concat (mastodon-tl--symbol 'reply) " " + (mastodon-tl--buttonify-link + "continued thread\n" + 'face 'mastodon-boosted-face + 'continued-thread t + 'help-echo "Browse thread")) + (let* ((acc (mastodon-tl--acc-by-id reply-acc-id)) + (name (or (alist-get 'display_name acc) + (alist-get 'username acc)))) + (concat (mastodon-tl--symbol 'reply) + (mastodon-tl--buttonify-link + " in reply to " + 'face 'mastodon-boosted-face + 'continued-thread t + 'help-echo "Browse thread") + (propertize name + 'face 'mastodon-display-name-face) + "\n"))))) + (t "")))) + +(defun mastodon-tl-continued-thread-load () + "Load thread based on prop item-id. +Used to load self-reply threads by clicking on top-byline's \"continued +thead\" text." + (interactive) + (let ((id (mastodon-tl--property 'item-id))) + (mastodon-tl--thread-do id))) + +(defun mastodon-tl--format-faved-or-boosted-byline (letter) + "Format the byline marker for a boosted or favourited status. +LETTER is a string, F for favourited, B for boosted, or K for bookmarked." + (let ((help-string (cond ((string= letter "F") + "favourited") + ((string= letter "B") + "boosted") + ((string= letter (or "🔖" "K")) + "bookmarked")))) + (format "(%s) " + (propertize letter 'face 'mastodon-boost-fave-face + ;; emojify breaks this for 🔖: + 'help-echo (format "You have %s this status." + ;; FIXME: this is often nil + help-string))))) + +(defun mastodon-tl--image-trans-check () + "Call `image-transforms-p', or `image-type-available-p' imagemagick." + (if (version< emacs-version "27.1") + (image-type-available-p 'imagemagick) + (image-transforms-p))) + +(defun mastodon-tl--byline (toot &optional detailed-p + domain base-toot group ts) + "Generate (bottom) byline for TOOT. +DETAILED-P means display more detailed info. For now +this just means displaying toot client. +When DOMAIN, force inclusion of user's domain in their handle. +BASE-TOOT is JSON for the base toot, if any. +GROUP is the notification group if any. +ACCOUNT is the notification account if any. +TS is a timestamp from the server, if any." + (let* ((type (alist-get 'type (or group toot))) + (created-time + (or ts ;; mentions, statuses, folls/foll-reqs + ;; bosts, faves, edits, polls in notifs view use base item + ;; timestamp: + (mastodon-tl--field 'created_at + (mastodon-tl--field 'status toot)) + ;; all other toots, inc. boosts/faves in timelines: + ;; (mastodon-tl--field auto fetches from reblogs if needed): + (mastodon-tl--field 'created_at toot))) + (parsed-time (when created-time (date-to-time created-time))) + ;; non-grouped notifs now need to pull the following data from + ;; base toot: + (base-maybe (or base-toot ;; show edits for notifs + (mastodon-tl--toot-or-base toot))) ;; for boosts + (faved (eq t (mastodon-tl--field 'favourited base-maybe))) + (boosted (eq t (mastodon-tl--field 'reblogged base-maybe))) + (bookmarked (eq t (mastodon-tl--field 'bookmarked base-maybe))) + (visibility (mastodon-tl--field 'visibility base-maybe)) + (account (alist-get 'account base-maybe)) + (botp (eq t (map-nested-elt base-maybe '(account bot)))) + (avatar-url (alist-get 'avatar account)) + (edited-time (alist-get 'edited_at base-maybe)) + (edited-parsed (when edited-time (date-to-time edited-time)))) + (concat + ;; Boosted/favourited markers are not technically part of the byline, so + ;; we don't propertize them with 'byline t', as per the rest. This + ;; ensures that `mastodon-tl-goto-next-item' puts point on + ;; author-byline, not before the (F) or (B) marker. Not propertizing like + ;; this makes the behaviour of these markers consistent whether they are + ;; displayed for an already boosted/favourited toot or as the result of + ;; the toot having just been favourited/boosted. + (concat (when boosted + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'boost))) + (when faved + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'favourite))) + (when bookmarked + (mastodon-tl--format-faved-or-boosted-byline + (mastodon-tl--symbol 'bookmark))) + (when botp + (concat (mastodon-tl--symbol 'bot) " "))) + ;; we remove avatars from the byline also, so that they also do not + ;; mess with `mastodon-tl-goto-next-item': + (when (and mastodon-tl--show-avatars + mastodon-tl--display-media-p + (mastodon-tl--image-trans-check)) + (mastodon-media--get-avatar-rendering avatar-url)) + (propertize + (concat + ;; NB: action-byline (boost) is now added in insert-status, so no + ;; longer part of the byline. + ;; (base) author byline: + ;; we use base-toot if poss for fave/boost notifs that need to show + ;; base item in author byline + (mastodon-tl--byline-author (or base-toot toot) + nil domain :base) + ;; visibility: + (cond ((string= visibility "direct") + (propertize (concat " " (mastodon-tl--symbol 'direct)) + 'help-echo visibility)) + ((string= visibility "private") + (propertize (concat " " (mastodon-tl--symbol 'private)) + 'help-echo visibility))) + " " + ;; timestamp: + (let ((ts (format-time-string + mastodon-toot-timestamp-format parsed-time))) + (propertize ts + 'timestamp parsed-time + 'display + (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description parsed-time) + parsed-time) + 'help-echo ts)) + ;; detailed: + (when detailed-p + (let* ((app-name (map-nested-elt toot '(application name))) + (app-url (map-nested-elt toot '(application website)))) + (when app-name + (concat + (propertize " via " 'face 'default) + (propertize app-name + 'face 'mastodon-display-name-face + 'follow-link t + 'mouse-face 'highlight + 'mastodon-tab-stop 'shr-url + 'shr-url app-url + 'help-echo app-url + 'keymap mastodon-tl--shr-map-replacement))))) + ;; edited: + (when edited-time + (concat + " " + (mastodon-tl--symbol 'edited) + " " + (propertize + (format-time-string mastodon-toot-timestamp-format + edited-parsed) + 'face 'mastodon-toot-docs-face + 'timestamp edited-parsed + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description edited-parsed) + edited-parsed)))) + (propertize (concat "\n " mastodon-tl--horiz-bar) + 'face 'default) + ;; stats: + (when (and mastodon-tl--show-stats + (not (member type '("follow" "follow_request")))) + (mastodon-tl--toot-stats toot)) + "\n") + 'favourited-p faved + 'boosted-p boosted + 'bookmarked-p bookmarked + ;; enable playing of videos when point is on byline: + 'attachments (mastodon-tl--get-attachments-for-byline toot) + 'edited edited-time + 'edit-history (when edited-time + (mastodon-toot--get-toot-edits + (alist-get 'id base-maybe))) + 'byline t)))) + + +;;; 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))) + + +;;; RENDERING HTML, LINKS, HASHTAGS, HANDLES + +(defun mastodon-tl--render-text (string &optional toot) + "Return a propertized text rendering the given HTML string STRING. +The contents comes from the given TOOT which is used in parsing +links in the text. If TOOT is nil no parsing occurs." + (when string ; handle rare empty notif server bug + (with-temp-buffer + (insert string) + (let ((shr-use-fonts mastodon-tl--enable-proportional-fonts) + (shr-width (when mastodon-tl--enable-proportional-fonts + (if mastodon-tl--no-fill-on-render + 0 + (- (window-width) 3)))) + (cat (get 'mastodon-tl-link 'button-category-symbol))) + (shr-render-region (point-min) (point-max)) + (alter-text-property + (point-min) (point-max) 'category + (lambda (type) (when type cat)))) + ;; Make all links a tab stop recognized by our own logic, make + ;; things point to our own logic (e.g. hashtags), and update keymaps + ;; where needed: + (when toot + (let (region) + (while (setq region (mastodon-tl--find-property-range + 'shr-url (or (cdr region) (point-min)))) + (mastodon-tl--process-link toot + (car region) (cdr region) + (get-text-property (car region) 'shr-url)) + (when (proper-list-p toot) ;; not on profile fields cons cells + ;; render card author maybe: + (let* ((card-url (map-nested-elt toot '(card url))) + (authors (map-nested-elt toot '(card authors))) + (url (buffer-substring (car region) (cdr region))) + (url-no-query (car (split-string url "?")))) + (when (and (string= url-no-query card-url) + ;; only if we have an account's data: + (alist-get 'account (car authors))) + (goto-char (point-max)) + (mastodon-tl--insert-card-authors authors))))))) + (buffer-string)))) + +(defun mastodon-tl--insert-card-authors (authors) + "Insert a string of card AUTHORS." + (let ((authors-str (format "Author%s: " + (if (< 1 (length authors)) "s" "")))) + (insert + (concat + "\n(" authors-str + (mapconcat #'mastodon-tl--format-card-author authors "\n") + ")\n")))) + +(defun mastodon-tl--format-card-author (data) + "Render card author DATA." + (when-let* ((account (alist-get 'account data))) ;.account + (let-alist account ;.account + ;; FIXME: replace with refactored handle render fun + ;; in byline refactor branch: + (concat + (propertize (mastodon-tl--unicode-wrap (or .display_name .username)) + 'face 'mastodon-display-name-face + 'item-type 'user + 'item-id .id) + " " + (propertize (concat "@" .acct) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + 'mastodon-tab-stop 'user-handle + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" .acct) + 'help-echo (concat "Browse user profile of @" .acct)))))) + +(defun mastodon-tl--process-link (toot start end url) + "Process link URL in TOOT as hashtag, userhandle, or normal link. +START and END are the boundaries of the link in the toot." + (let* (mastodon-tab-stop-type + keymap + (help-echo (get-text-property start 'help-echo)) + extra-properties + ;; handle calling this on non-toots, e.g. for profiles: + (toot-url (when (proper-list-p toot) + (mastodon-tl--field 'url toot))) + (toot-url (when toot-url (url-generic-parse-url toot-url))) + (toot-instance-url (if toot-url + (concat (url-type toot-url) "://" + (url-host toot-url)) + mastodon-instance-url)) + (link-str (buffer-substring-no-properties start end)) + (maybe-hashtag (mastodon-tl--hashtag-from-url + url toot-instance-url)) + (maybe-userhandle + (if (proper-list-p toot) ; fails for profile buffers? + (or (mastodon-tl--userhandle-from-mentions toot link-str) + (mastodon-tl--userhandle-from-url url link-str)) + (mastodon-tl--userhandle-from-url url link-str)))) + (cond (maybe-hashtag + (setq mastodon-tab-stop-type 'hashtag + keymap mastodon-tl--link-keymap + help-echo (concat "Browse tag #" maybe-hashtag) + extra-properties (list 'mastodon-tag maybe-hashtag))) + (maybe-userhandle ;; fails on mentions in profile notes: + (let ((maybe-userid (when (proper-list-p toot) + (mastodon-tl--extract-userid-toot + toot link-str)))) + (setq mastodon-tab-stop-type 'user-handle + keymap mastodon-tl--link-keymap + help-echo (concat "Browse user profile of " maybe-userhandle) + extra-properties (append + (list 'mastodon-handle maybe-userhandle) + (when maybe-userid + (list 'account-id maybe-userid)))))) + (t ;; Anything else (leave it as a url handled by shr.el): + (setq keymap (if (eq shr-map (get-text-property start 'keymap)) + mastodon-tl--shr-map-replacement + mastodon-tl--shr-image-map-replacement) + mastodon-tab-stop-type 'shr-url))) + (add-text-properties start end + (append + (list 'mastodon-tab-stop mastodon-tab-stop-type + 'keymap keymap + 'help-echo help-echo) + extra-properties)))) + +(defun mastodon-tl--userhandle-from-mentions (toot link) + "Extract a user handle from mentions in json TOOT. +LINK is maybe the `@handle' to search for." + (mastodon-tl--el-from-mentions 'acct toot link)) + +(defun mastodon-tl--extract-userid-toot (toot link) + "Extract a user id for an ACCT from mentions in a TOOT. +LINK is maybe the `@handle' to search for." + (mastodon-tl--el-from-mentions 'id toot link)) + +(defun mastodon-tl--el-from-mentions (el toot link) + "Extract element EL from TOOT mentions that matches LINK. +LINK should be a simple handle string with no domain, i.e. \"@user\". +Return nil if no matching element." + (let ((mentions (alist-get 'mentions toot))) + (when mentions + (let* ((mention (pop mentions)) + (name (substring-no-properties link 1 (length link))) ; cull @ + return) + (while mention + (when (string= name (alist-get 'username mention)) + (setq return (alist-get el mention))) + (setq mention (pop mentions))) + return)))) + +(defun mastodon-tl--userhandle-from-url (url &optional buffer-text) + "Return the user hande the URL points to or nil if it is not a profile link. +BUFFER-TEXT is the text covered by the link with URL, for a user profile +this should be of the form , e.g. \"@Gargon\". +This is called on all post URLs, so needs to handle non profile URLs +gracefully." + (let* ((parsed-url (url-generic-parse-url url)) + (host (url-host parsed-url)) + (local-p (string= + (url-host (url-generic-parse-url mastodon-instance-url)) + host)) + (path-raw (url-filename parsed-url))) + (unless (string-empty-p path-raw) + (let ((path (substring path-raw 1))) ;; remove "/" prefix + (if (not buffer-text) + (when (string-prefix-p "@" path) + (if local-p path (concat "@" host))) + (when (and (string= "@" (substring buffer-text 0 1)) + ;; don't error on domain only url (rare): + (string= (downcase buffer-text) + (downcase path))) + (if local-p + buffer-text ; no instance suffix for local mention + (concat buffer-text "@" host)))))))) + +(defun mastodon-tl--hashtag-from-url (url instance-url) + "Return the hashtag that URL points to or nil if URL is not a tag link. +INSTANCE-URL is the url of the instance for the toot that the link +came from (tag links always point to a page on the instance publishing +the toot)." + ;; TODO: do we rly need to check it against instance-url? + ;; test suggests we might + (let* ((instance-host (url-host + (url-generic-parse-url instance-url))) + (parsed (url-generic-parse-url url)) + (path (url-filename parsed))) + (when (string= instance-host (url-host parsed)) + (cond ((string-prefix-p "/tag" path) ;; "/tag/" or "/tags/" + (let ((split (split-string path "/"))) + (nth 2 split))) + ((string-prefix-p "?t=" path) ;; snac tag + (let ((split (split-string path "="))) + (nth 1 split))))))) + +(defun mastodon-tl--base-tags (tags body-tags) + "Return a string of all tags not in BODY-TAGS, linkified. +TAGS is a list of tag alists, from a post's JSON." + (when (mastodon-tl--base-tags-print-p tags body-tags) + (concat + "\n" + (cl-loop for tag in tags + concat (concat (mastodon-tl--render-base-tag tag body-tags) + " "))))) + +(defun mastodon-tl--base-tags-print-p (tags body-tags) + "Non-nil if we need to print base tags. +We need to do so if TAGS contains any elements not in BODY-TAGS." + (cl-remove-if + (lambda (tag) + ;; downcase name string (body strings are downcased): + (member (downcase (alist-get 'name tag)) body-tags)) + tags)) + +(defun mastodon-tl--render-base-tag (tag body-tags) + "Return TAG as a linkified string, provided it is not in BODY-TAGS." + (let ((name (alist-get 'name tag))) + (unless (member (downcase name) body-tags) + (mastodon-tl--buttonify-link + (concat "#" name) + 'mastodon-tab-stop 'hashtag + 'mastodon-tag name + 'mouse-face '(highlight) + 'keymap mastodon-tl--link-keymap + 'face '(shr-text shr-link) + 'follow-link t + 'shr-tab-stop t + 'shr-url (alist-get 'url tag) + 'help-echo (concat "Browse tag #" name))))) + + +;;; HYPERLINKS + +(define-button-type 'mastodon-tl-link + 'action #'mastodon-tl--push-button + 'keymap mastodon-tl--link-keymap + 'mouse-face 'highlight) + +(defun mastodon-tl--push-button (button) + "Do the appropriate action for BUTTON." + (mastodon-tl-do-link-action-at-point (button-start button))) + +(defun mastodon-tl--buttonify-link (string &rest properties) + "Make STRING a `mastodon-tl-link' type button. +PROPERTIES are additional properties to attach to string." + (apply #'propertize string + 'button t + 'category (get 'mastodon-tl-link 'button-category-symbol) + properties)) + +(defun mastodon-tl--make-link (string link-type) + "Return a propertized version of STRING that will act like link. +LINK-TYPE is the type of link to produce." + (let ((help-text (cond ((eq link-type 'content-warning) + "Toggle hidden text") + ((or (eq link-type 'read-more) + (eq link-type 'read-less)) + "Toggle full post") + (t + (error "Unknown link type %s" link-type))))) + (mastodon-tl--buttonify-link string + 'mastodon-tab-stop link-type + 'help-echo help-text))) + +(defun mastodon-tl-do-link-action-at-point (pos) + "Do the action of the link at POS. +Used for hitting RET on a given link." + (interactive "d") + (let ((link-type (get-text-property pos 'mastodon-tab-stop)) + (cont-thread (mastodon-tl--property 'continued-thread :nomove)) + (quote-toot (mastodon-tl--property 'quote-url :nomove))) + (cond (cont-thread + (mastodon-tl-continued-thread-load)) + (quote-toot + (let ((url (mastodon-tl--property 'quote-url :nomove))) + (mastodon-url-lookup url))) + ((eq link-type 'content-warning) + (mastodon-tl--toggle-spoiler-text pos)) + ((eq link-type 'hashtag) + (mastodon-tl--show-tag-timeline + nil (get-text-property pos 'mastodon-tag))) + ;; 'account / 'account-id is not set for mentions, only bylines + ((eq link-type 'user-handle) + (let ((account-json (get-text-property pos 'account)) + (account-id (get-text-property pos 'account-id))) + (cond + (account-json + (mastodon-profile--make-author-buffer account-json)) + (account-id + (mastodon-profile--make-author-buffer + (mastodon-profile--account-from-id account-id))) + (t + (let ((account (mastodon-profile--search-account-by-handle + (get-text-property pos 'mastodon-handle)))) + ;; never call make-author-buffer on nil account: + (cond (account + (mastodon-profile--make-author-buffer account)) + ;; optional webfinger lookup: + ((y-or-n-p + "Search for account returned nothing. Perform URL lookup?") + (mastodon-url-lookup (get-text-property pos 'shr-url))) + (t + (error "Unable to find account")))))))) + ((eq link-type 'shr-url) + (mastodon-url-lookup (get-text-property pos 'shr-url))) + ((eq link-type 'read-more) + (mastodon-tl-unfold-post)) + ((eq link-type 'read-less) + (mastodon-tl-fold-post)) + (t + (error "Unknown link type %s" link-type))))) + +(defun mastodon-tl-do-link-action (event) + "Do the action of the link at point. +Used for a mouse-click EVENT on a link." + (interactive "@e") + (mastodon-tl-do-link-action-at-point (posn-point (event-end event)))) + + +;;; CONTENT WARNINGS + +(defun mastodon-tl--has-spoiler (toot) + "Check if the given TOOT has a spoiler text. +Spoiler text should initially be shown only while the main +content should be hidden." + (let ((spoiler (mastodon-tl--field 'spoiler_text toot))) + (and spoiler (> (length spoiler) 0)))) + +(defun mastodon-tl--toggle-spoiler-text (position) + "Toggle the visibility of the spoiler text at/after POSITION." + (let* ((inhibit-read-only t) + (spoiler-region (mastodon-tl--find-property-range + 'mastodon-content-warning-body position nil)) + (new-state (not (get-text-property (car spoiler-region) + 'invisible)))) + (if (not spoiler-region) + (user-error "No spoiler text here") + (add-text-properties (car spoiler-region) (cdr spoiler-region) + (list 'invisible new-state)) + new-state))) ;; return what we set invisibility to + +(defun mastodon-tl-toggle-spoiler-text-in-toot () + "Toggle the visibility of the spoiler text in the current toot." + (interactive) + (let* ((toot-range (or (mastodon-tl--find-property-range + 'item-json (point)) + (mastodon-tl--find-property-range + 'item-json (point) t))) + (spoiler-range (when toot-range + (mastodon-tl--find-property-range + 'mastodon-content-warning-body + (car toot-range))))) + (cond ((null toot-range) + (user-error "No toot here")) + ((or (null spoiler-range) + (> (car spoiler-range) (cdr toot-range))) + (user-error "No content warning text here")) + (t + (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) + +(defun mastodon-tl-toggle-spoiler-in-thread () + "Toggler content warning for all posts in current thread." + (interactive) + (let ((thread-p (eq (mastodon-tl--buffer-property 'update-function) + 'mastodon-tl--thread-do))) + (if (not thread-p) + (user-error "Not in a thread") + (save-excursion + (goto-char (point-min)) + (while (not (string= "No more items" ; improve this hack test! + (mastodon-tl-goto-next-item :no-refresh))) + (let* ((json (mastodon-tl--property 'item-json :no-move)) + (cw (alist-get 'spoiler_text json))) + (when (not (string= "" cw)) + (let ((new-state + (pcase + (mastodon-tl-toggle-spoiler-text-in-toot) + ('t 'folded) + ('nil 'unfolded)))) + (plist-put mastodon-tl--buffer-spec + 'thread-unfolded new-state))))))))) + +(defun mastodon-tl--spoiler (toot &optional filter) + "Render TOOT with spoiler message. +This assumes TOOT is a toot with a spoiler message. +The main body gets hidden and only the spoiler text and the +content warning message are displayed. The content warning +message is a link which unhides/hides the main body. +FILTER is a string to use as a filter warning spoiler instead." + (let* ((spoiler (mastodon-tl--field 'spoiler_text toot)) + (string (mastodon-tl--set-face + (mastodon-tl--clean-tabs-and-nl + (mastodon-tl--render-text spoiler toot)) + 'default)) + (message (concat " " mastodon-tl--horiz-bar "\n " + (mastodon-tl--make-link + (if filter + (concat "Filtered: " filter) + (concat "CW: " string)) + 'content-warning) + "\n " + mastodon-tl--horiz-bar "\n")) + (cw (mastodon-tl--set-face message 'mastodon-cw-face))) + (concat + cw + (propertize + (mastodon-tl--content toot) + 'invisible (mastodon-tl--spoiler-invisible-maybe filter) + 'mastodon-content-warning-body t)))) + +(defun mastodon-tl--spoiler-invisible-maybe (&optional filter) + "Set the invisible property for a post with a spoiler. +Also used to set invisibility for quoted posts. +We respect `mastodon-tl--expand-content-warnings'. +If it is server, we check the user's preference. +FILTER means we go invisible." + (or filter ;; filters = invis + (let ((cust mastodon-tl--expand-content-warnings)) + (if (not (eq 'server cust)) + (not cust) ;; opp to setting + ;; respect server setting: + ;; If something goes wrong reading prefs, + ;; just return t so CWs fold by default. + (condition-case nil + (eq :json-false + (mastodon-profile--get-preferences-pref + 'reading:expand:spoilers)) + (error t)))))) + + +;;; MEDIA + +(defun mastodon-tl--media (toot) + "Retrieve a media attachment link for TOOT if one exists. +Else return an empty string." + (let* ((attachments (mastodon-tl--field 'media_attachments toot)) + (sensitive (mastodon-tl--field 'sensitive toot)) + (media-string (mapconcat + (lambda (x) + (mastodon-tl--media-attachment x sensitive)) + attachments ""))) + (if (not (and mastodon-tl--display-media-p + (string-empty-p media-string))) + (concat "\n" media-string) + ""))) + +(defun mastodon-tl--media-attachment (attachment sensitive) + "Return a propertized string for ATTACHMENT. +SENSITIVE is a flag from the item's JSON data." + (let-alist attachment + (let ((display-str + (concat "Media:: " + (if (and mastodon-tl--display-caption-not-url-when-no-media + .description) + .description + .preview_url))) + (remote-url (or .remote_url .url))) + (if (and mastodon-tl--display-media-p + ;; if in notifs, also check notifs images custom: + (if (or (mastodon-tl--buffer-type-eq 'notifications) + (mastodon-tl--buffer-type-eq 'mentions)) + mastodon-images-in-notifs + t)) + (mastodon-media--get-media-link-rendering ; placeholder: "[img]" + .preview_url remote-url ; for shr-browse-url + .type .description sensitive) + ;; return URL/caption: + (concat (mastodon-tl--propertize-img-str-or-url + (concat "Media:: " .preview_url) ; string + .preview_url remote-url .type .description + display-str 'shr-link .description sensitive) + "\n"))))) + +(defun mastodon-tl--propertize-img-str-or-url + (str media-url full-remote-url type help-echo + &optional display face caption sensitive) + "Propertize an media placeholder string \"[img]\" or media URL. +STR is the string to propertize, MEDIA-URL is the preview link, +FULL-REMOTE-URL is the link to the full resolution image on the +server, TYPE is the media type. +HELP-ECHO, DISPLAY, and FACE are the text properties to add. +CAPTION is the image caption, added as a text property. +SENSITIVE is a flag from the item's JSON data." + (propertize str + 'media-url media-url + 'media-state (when (string= str "[img]") 'needs-loading) + 'media-type 'media-link + 'mastodon-media-type type + 'display display + 'face face + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url (or full-remote-url media-url) ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'image-description caption + 'shr-alt caption ; for shr-show-alt-text + 'sensitive sensitive + 'help-echo (if (or (string= type "image") + (string= type nil) + (string= type "unknown")) ; handle borked images + help-echo + (concat help-echo "\nC-RET: play " type " with mpv")))) + +;;; FULL IMAGE VIEW + +(define-derived-mode mastodon-image-mode image-mode + "mastodon-image" + :group 'mastodon + ;; Disable `pixel-scroll-precision-mode' locally because it doesn't + ;; work nicely with `mastodon-image-mode': + ;; thanks Tusar for this fix: + (when (bound-and-true-p pixel-scroll-precision-mode) + (setq-local pixel-scroll-precision-mode nil))) + +;; patch `shr-browse-image' to accept url arg: +(defun mastodon-tl-shr-browse-image (&optional arg) + "Browse the image under point. +With prefix argument ARG, copy the URL of the image instead. +If URL is a string, use it rather than the image-url property at point." + (interactive "P") + (let ((prop (get-text-property (point) 'image-url))) + (if current-prefix-arg + (if (not prop) + (user-error "No image at point?") + (with-temp-buffer + (insert prop) + (copy-region-as-kill (point-min) (point-max)) + (message "Copied %s" prop))) + (let ((url (or arg prop))) + (if (not url) + (user-error "No URL here?") + (message "Browsing %s..." url) + (browse-url url)))))) + +(defun mastodon-tl--view-image-url (url attachments) + "View image URL. Set ATTACHMENTS metadata in image buffer." + (if (not url) + (user-error "No url found") + (if (not mastodon-tl--load-full-sized-images-in-emacs) + (mastodon-tl-shr-browse-image url) + (mastodon-media--image-or-cached + url #'mastodon-media--process-full-sized-image-response + `(nil ,url ,attachments ,(buffer-name)))))) + +(defun mastodon-tl-view-full-image-at-point () + "Browse full-sized version of image at point in a new window." + (interactive) + (if (not (eq (mastodon-tl--property 'mastodon-tab-stop) 'image)) + (user-error "No image at point?") + (let* ((url (mastodon-tl--property 'image-url)) + (attachments (mastodon-tl--property 'attachments))) + (mastodon-tl--view-image-url url attachments)))) + +(defun mastodon-tl-view-first-full-image () + "From item byline, fetch load its first full image." + (interactive) + (let* ((attachments (mastodon-tl--property 'attachments)) + (url (plist-get (car attachments) :url))) + (if (not attachments) + (user-error "Toot has no attachments") + (mastodon-tl--view-image-url url attachments)))) + +(defun mastodon-tl--get-next-image-url () + "Return the url for the next image to load. +Cycles through values in `mastodon-media--attachments'." + (let* ((url (car mastodon-media--attachments)) + ;; match url against our plists: + (current (mastodon-tl--current-image-url url))) + ;; fetch from next item in current or use first item if current has + ;; only 1 item: + (plist-get (if (= 1 (length current)) + (cadr mastodon-media--attachments) + (cadr current)) + :url))) + +(defun mastodon-tl--current-image-url (url) + "Try to fetch URL from `mastodon-media--attachments'. +The return value is that of `cl-member-if', ie if a match is found, it +returns the match and the list of which it is the car." + (cl-member-if + (lambda (attachment) + (equal url (plist-get attachment :url))) + (cdr mastodon-media--attachments))) + +(defun mastodon-tl--get-prev-image-url () + "Return the URL of the previous item in `mastodon-media--attachments'." + (let* ((url (car mastodon-media--attachments)) + (current (mastodon-tl--current-image-url url))) + (plist-get (nth (1- (length current)) + (cdr mastodon-media--attachments)) + :url))) + +(defun mastodon-tl-next-full-image () + "From full image view buffer, load the toot's next image." + (interactive) + (let* ((next-url (mastodon-tl--get-next-image-url))) + (mastodon-tl--view-image-url next-url + (cdr mastodon-media--attachments)))) + +(defun mastodon-tl-prev-full-image () + "From full image view buffer, load the toot's prev image." + (interactive) + (let* ((prev-url (mastodon-tl--get-prev-image-url))) + (mastodon-tl--view-image-url prev-url + (cdr mastodon-media--attachments)))) + +(defun mastodon-tl-toggle-sensitive-image () + "Toggle dislay of sensitive image at point." + (interactive) + (if (not (eq t (mastodon-tl--property 'sensitive))) + (user-error "No sensitive media at point?") + (let ((data (mastodon-tl--property 'image-data :no-move)) + (inhibit-read-only t) + (end (next-single-property-change (point) 'sensitive-state))) + (add-text-properties + (point) end + (if (eq 'hidden (mastodon-tl--property 'sensitive-state :no-move)) + ;; display: + `( display ,data + sensitive-state showing) + ;; hide: + `( sensitive-state hidden + display + ,(create-image + mastodon-media--sensitive-image-data nil t))))))) + + +;; POLLS + +(defun mastodon-tl--format-poll-option (option counter length) + "Format poll OPTION. COUNTER is a counter. +LENGTH is of the longest option, for formatting." + (format "%s: %s%s%s\n" + counter + (propertize (alist-get 'title option) + 'face 'success) + (make-string (1+ (- length + (length (alist-get 'title option)))) + ?\ ) + ;; TODO: disambiguate no votes from hidden votes + (format "[%s votes]" (or (alist-get 'votes_count option) + "0")))) + +(defun mastodon-tl--format-poll (poll) + "From json poll data POLL, return a display string." + (let-alist poll + (let* ((options (mastodon-tl--map-alist 'title .options)) + (longest (car (sort (mapcar #'length options ) #'>))) + (counter 0)) + (concat "\n" + (mastodon-tl--symbol 'poll) + "\n\n" + (mapconcat (lambda (option) + (setq counter (1+ counter)) + (mastodon-tl--format-poll-option + option counter longest)) + .options + "\n") + "\n" + (propertize + (cond (.voters_count ; sometimes it is nil + (format "%s %s | " .voters_count + (if (= .voters_count 1) "person" "people"))) + (.vote_count + (format "%s votes | " .vote_count)) + (t "")) + 'face 'mastodon-toot-docs-face) + (let ((str (if (eq .expired :json-false) + (if (eq .expires_at nil) + "" + (mastodon-tl--format-poll-expiry .expires_at)) + "Poll expired."))) + (propertize str 'face 'mastodon-toot-docs-face)) + "\n")))) + +(defconst mastodon-tl--time-units + '("sec" 60.0 ;; Use a float to convert `n' to float. + "min" 60 + "hour" 24 + "day" 7 + "week" 4.345 + "month" 12 + "year")) + +(defun mastodon-tl--format-poll-expiry (timestamp) + "Convert poll expiry TIMESTAMP into a descriptive string. +TIMESTAMP is from the expires_at field of a poll's JSON data, and +is in ISO 8601 Datetime format." + (let* ((ts (encode-time (parse-time-string timestamp))) + (seconds (time-to-seconds (time-subtract ts nil)))) + ;; FIXME: Use the `cdr' to update poll expiry times? + (concat (car (mastodon-tl--human-duration (max 0 seconds))) " left"))) + +(defun mastodon-tl--human-duration (seconds &optional resolution) + "Return a string describing SECONDS in a more human-friendly way. +The return format is (STRING . RES) where RES is the resolution of +this string, in seconds. +RESOLUTION is the finest resolution, in seconds, to use for the +second part of the output (defaults to 60, so that seconds are only +displayed when the duration is smaller than a minute)." + (cl-assert (>= seconds 0)) + (unless resolution (setq resolution 60)) + (let* ((units mastodon-tl--time-units) + (n1 seconds) (unit1 (pop units)) (res1 1) + n2 unit2 res2 + next) + (while (and units (> (truncate (setq next (/ n1 (car units)))) 0)) + (setq unit2 unit1) + (setq res2 res1) + (setq n2 (- n1 (* (car units) (truncate n1 (car units))))) + (setq n1 next) + (setq res1 (truncate (* res1 (car units)))) + (pop units) + (setq unit1 (pop units))) + (setq n1 (truncate n1)) + (if n2 (setq n2 (truncate n2))) + (cond + ((null n2) + ;; revert to old just now style for < 1 min: + (cons "just now" 60)) + ;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) + ;; (max resolution res1))) + ((< (* res2 n2) resolution) + (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) + (max resolution res2))) + ((< res2 resolution) + (let ((n2 (/ (* resolution (/ (* n2 res2) resolution)) res2))) + (cons (format "%d %s%s, %d %s%s" + n1 unit1 (if (> n1 1) "s" "") + n2 unit2 (if (> n2 1) "s" "")) + resolution))) + (t + (cons (format "%d %s%s, %d %s%s" + n1 unit1 (if (> n1 1) "s" "") + n2 unit2 (if (> n2 1) "s" "")) + (max res2 resolution)))))) + +(defun mastodon-tl--format-read-poll-option (options) + "Format poll OPTIONS for `completing-read'. +OPTIONS is an alist." + ;; we display option number and the option title + ;; but also store both as a cons cell as the cdr, as we need it later + (cl-loop for cell in options + collect (cons (format "%s | %s" (car cell) (cdr cell)) + cell))) + +(defun mastodon-tl--read-poll-option () + "Read a poll option to vote on a poll." + (let* ((toot (mastodon-tl--property 'item-json)) + (poll (mastodon-tl--field 'poll toot))) + (if (null poll) + (user-error "No poll here") + (let* ((options (mastodon-tl--field 'options poll)) + (titles (mastodon-tl--map-alist 'title options)) + (number-seq (number-sequence 1 (length options))) + (numbers (mapcar #'number-to-string number-seq)) + (options-alist (cl-mapcar #'cons numbers titles)) + (candidates (mastodon-tl--format-read-poll-option options-alist)) + (choice (completing-read "Poll option to vote for: " + candidates nil :match))) + (list (cdr (assoc choice candidates))))))) + +(defun mastodon-tl-poll-vote (option) + "If there is a poll at point, prompt user for OPTION to vote on it." + (interactive (mastodon-tl--read-poll-option)) + (let ((toot (mastodon-tl--property 'item-json))) + (if (null (mastodon-tl--field 'poll toot)) + (user-error "No poll here") + (let* ((poll (mastodon-tl--field 'poll toot)) + (id (alist-get 'id poll)) + (url (mastodon-http--api (format "polls/%s/votes" id))) + ;; zero-index our option: + (option-arg (number-to-string + (1- (string-to-number (car option))))) + (arg `(("choices[]" . ,option-arg))) + (response (mastodon-http--post url arg))) + (mastodon-http--triage response + (lambda (_) + (message "You voted for option %s: %s!" + (car option) (cdr option)))))))) + + +;; VIDEOS / MPV + +(defun mastodon-tl--find-first-video-in-attachments () + "Return the first media attachment that is a moving image." + (let ((attachments (mastodon-tl--property 'attachments)) + vids) + (cl-loop for x in attachments + do (let ((att-type (plist-get x :type))) + (when (or (string= "video" att-type) + (string= "gifv" att-type)) + (push x vids)))) + (car vids))) + +(defun mastodon-tl-mpv-play-video-from-byline () + "Run `mastodon-tl-mpv-play-video-at-point' on first moving image in post." + (interactive) + (let* ((video (mastodon-tl--find-first-video-in-attachments)) + (url (plist-get video :url)) + (type (plist-get video :type))) + (mastodon-tl-mpv-play-video-at-point url type))) + +(defun mastodon-tl-view-full-image-or-play-video (_pos) + "View full sized version of image at point, or try to play video." + (interactive "d") + (if (mastodon-tl--media-video-p) + (mastodon-tl-mpv-play-video-at-point) + (mastodon-tl-view-full-image-at-point))) + +(defun mastodon-tl-click-image-or-video (event) + "Click to play video with `mpv.el'. +EVENT is a mouse-click arg." + (interactive "@e") + (mastodon-tl-view-full-image-or-play-video + (posn-point (event-end event)))) + +(defun mastodon-tl--media-video-p (&optional type) + "T if mastodon-media-type prop is \"gifv\" or \"video\". +TYPE is a mastodon media type." + (let ((type (or type (mastodon-tl--property 'mastodon-media-type :no-move)))) + (or (string= type "gifv") + (string= type "video")))) + +(defun mastodon-tl-mpv-play-video-at-point (&optional url type) + "Play the video or gif at point with an mpv process. +URL and TYPE are provided when called while point is on byline, +in which case play first video or gif from current toot." + (interactive) + (let ((url (or url ; point in byline: + (mastodon-tl--property 'image-url :no-move)))) ; point in toot + (if (or (not url) + (not (mastodon-tl--media-video-p type))) + (user-error "No moving image here?") + (message "'q' to kill mpv.") + (condition-case x + (mpv-start "--loop" url) + (void-function + (message "Looks like mpv.el not installed. Error: %s" + (error-message-string x))))))) + +(defun mastodon-tl-copy-image-caption () + "Copy the caption of the image at point." + (interactive) + (if-let* ((desc (get-text-property (point) 'image-description))) + (progn + (kill-new desc) + (message "Image caption copied.")) + (message "No image caption."))) + + +;;; INSERT TOOTS + +(defun mastodon-tl--content (toot) + "Retrieve text content from TOOT. +Runs `mastodon-tl--render-text' and fetches poll or media." + (let* ((content (mastodon-tl--field 'content toot)) + (quote-p (mastodon-tl--field 'quote toot)) + (rendered (mastodon-tl--render-text content toot)) + (stripped-maybe (if (not quote-p) + rendered + (with-temp-buffer ;; strip quoted toot URL: + (insert rendered) + (goto-char (point-min)) + (kill-line 2) + (buffer-string)))) + (poll-p (mastodon-tl--field 'poll toot)) + (media-p (mastodon-tl--field 'media_attachments toot))) + (concat stripped-maybe + (when poll-p + (mastodon-tl--format-poll + (mastodon-tl--field 'poll toot))) ;; toot or reblog + (when media-p + (mastodon-tl--media toot))))) + +(defun mastodon-tl--prev-item-id () + "Return the id of the last toot inserted into the buffer." + (let* ((prev-change + (save-excursion + (previous-single-property-change (point) 'base-item-id))) + (prev-pos (when prev-change (1- prev-change)))) + (when prev-pos + (get-text-property prev-pos 'base-item-id)))) + +(defun mastodon-tl--after-reply-status (reply-to-id) + "T if REPLY-TO-ID is equal to that of the last toot inserted in the bufer." + (let ((prev-id (mastodon-tl--prev-item-id))) + (string= reply-to-id prev-id))) + +(defun mastodon-tl--body-tags (body) + "Return a plain string list of the tags in BODY." + ;; NB: replies on text props 'mastodon-tab-stop and 'shr-url + ;; FIXME: snac tags fail our prop test, not sure about others. + (let (list prop) + (with-temp-buffer + (insert body) + (goto-char (point-min)) + (save-match-data + (while + (setq prop (text-property-search-forward + 'mastodon-tab-stop 'hashtag t)) + (goto-char (prop-match-beginning prop)) + (let ((tag (mastodon-tl--property 'mastodon-tag))) + (when tag + (push (downcase tag) list))) + (goto-char (prop-match-end prop))))) + list)) + +(defvar mastodon-tl--quote-states + '(pending accepted rejected revoked deleted + unauthorized blocked_account blocked_domain muted_account) + "A list of possible values for a quote state attribute. +See https://docs.joinmastodon.org/entities/Quote/#state for details.") + +(defun mastodon-tl--quote-symbol-str () + "Return a propertized quote symbol, \"." + ;; quote symbol hack: + (propertize "“" 'face + '( :inherit success :weight bold + :height 1.8))) + +(defun mastodon-tl--insert-quoted (data toot) + "Propertize quoted status DATA for insertion. +TOOT is the data for the quoting toot." + (let* ((bar (concat " " (mastodon-tl--symbol 'reply-bar))) + (state (alist-get 'state data)) + ;; CW status of quoting toot: + (cw (not (string-empty-p + (mastodon-tl--field 'spoiler_text toot)))) + (quoted (alist-get 'quoted_status data))) + (let-alist quoted + (let ((filters (when .filtered + (mastodon-tl--current-filters .filtered)))) + ;; TODO: tailor non-disply of quote based on quote 'state' + ;; `mastodon-tl--quote-states': + (propertize + (cond + ((or (assoc "warn" filters) + (assoc "hide" filters)) + ;; FIXME: "warn" should result in CW, but it should be + ;; a CW independent of post CW: + (mastodon-tl--format-quote-non-display + "Quote hidden due to one of your filters")) + ;; FIXME: muted account should result in a folded quote + ;; (unfoldable): + ((string= state "muted_account") + (mastodon-tl--format-quote-non-display + "Quote hidden, account muted")) + ((member state '("rejected" "revoked" "deleted")) + (mastodon-tl--format-quote-non-display + (format "Quote %s" state))) + ((member state '("blocked_account" "blocked_domain")) + (mastodon-tl--format-quote-non-display + (format "Quote hidden, %s" state))) + ((string= state "pending") + (mastodon-tl--format-quote-non-display "quote pending")) + (t + (concat + "\n" (mastodon-tl--quote-symbol-str) "\n" + ;; author byline without horiz bar/stats: + (concat + (mastodon-tl--byline-author quoted nil nil :base) + "\n" + (propertize ;; buttonize quoted toot body + ;; quoted text: + (mastodon-tl--content quoted) + 'button t + 'keymap mastodon-tl--link-keymap + 'help-echo "Load quoted toot" + 'mouse-face '(:inherit (highlight link) :underline nil)))))) + 'line-prefix bar + 'wrap-prefix bar + 'quote-url .url + 'mastodon-content-warning-body (when cw t) + ;; TODO: respect filtering of quoted toot: + 'invisible (when cw (mastodon-tl--spoiler-invisible-maybe)) + 'mastodon-quote data))))) + +(defun mastodon-tl--format-quote-non-display (str) + "Return a non-displaying quote string for STR." + (concat "\n\n" (mastodon-tl--quote-symbol-str) "\n[" str "]")) + +;; PUT /api/v1/statuses/:id/interaction_policy +(defun mastodon-tl--change-post-quote-policy () + "Change the quote policy of the toot at point. +Toot must be on you own." + (interactive) + ;; SCOPE: with own toot: + (let ((toot (mastodon-tl--property 'item-json :no-move))) + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only set quote policy for your own posts") + (let* ((id (mastodon-tl--property 'item-id)) + (current (car (map-nested-elt toot + '(quote_approval automatic)))) + (choice (completing-read (format "Set quote policy [%s]: " current) + mastodon-profiles-quote-policy-types + nil :match)) + (url (mastodon-http--api (format "statuses/%s/interaction_policy" + id))) + (resp (mastodon-http--put + url `(("quote_approval_policy" . ,choice))))) + (mastodon-http--triage + resp + (lambda (resp) + (let* ((json (with-current-buffer resp + (mastodon-http--process-json))) + (set (or (car (map-nested-elt json '(quote_approval automatic))) + "nobody"))) ;; nil on the server = nobody + (message "Quote policy for post updated to: %s!" set)))))))) + +(defun mastodon-tl--insert-status + (toot body &optional detailed-p thread domain unfolded no-byline + cw-expanded) + "Display the content and byline of timeline element TOOT. +BODY will form the section of the toot above the byline. +DETAILED-P means display more detailed info. For now +this just means displaying toot client. +THREAD means the status will be displayed in a thread view. +When DOMAIN, force inclusion of user's domain in their handle. +UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. +NO-BYLINE means just insert toot body, used for folding. +CW-EXPANDED means treat content warnings as unfolded." + (let* ((reply-to-id (alist-get 'in_reply_to_id toot)) + (after-reply-status-p + (when (and thread reply-to-id) + (mastodon-tl--after-reply-status reply-to-id))) + ;; (type (alist-get 'type toot)) + (toot-foldable + (and mastodon-tl--fold-toots-at-length + (length> body mastodon-tl--fold-toots-at-length))) + (cw-p (not (string-empty-p + (alist-get 'spoiler_text toot)))) + (body-tags (mastodon-tl--body-tags body)) + (quote (mastodon-tl--field 'quote toot))) + (insert + (propertize ;; body + byline: + (concat + (propertize ;; body only: + (concat + "\n" + (mastodon-tl--top-byline toot) ;; (boost, in reply to) + ;; relpy symbol: + (when (and after-reply-status-p thread) + (concat (mastodon-tl--symbol 'replied) + "\n")) + ;; actual body: + (let ((bar (mastodon-tl--symbol 'reply-bar)) + (body (if (and toot-foldable (not unfolded)) + (mastodon-tl--fold-body body) + body))) + (concat + (if (and after-reply-status-p thread) + (propertize body + 'line-prefix bar + 'wrap-prefix bar) + body) + ;; insert quote maybe: + (when quote + (mastodon-tl--insert-quoted quote toot)))) + (if (and toot-foldable unfolded cw-expanded) + (mastodon-tl--read-more-or-less + "LESS" cw-p (not cw-expanded)) + "")) + 'toot-body t) ;; includes newlines etc. for folding + ;; post tags: + (let ((tags (alist-get 'tags toot))) + ;; FIXME: we also need to test here for normal body tags, and if + ;; so, don't go ahead: + (if tags (concat (mastodon-tl--base-tags tags body-tags)) "")) + ;; byline: + "\n" + (if no-byline + "" + (mastodon-tl--byline toot detailed-p domain))) + 'item-type 'toot + 'item-id (alist-get 'id toot) ; toot id + 'base-item-id (mastodon-tl--item-id toot) ; with reblog check + 'item-json toot + 'cursor-face 'mastodon-cursor-highlight-face + 'toot-foldable toot-foldable + 'toot-folded (and toot-foldable (not unfolded))) + (if no-byline "" "\n")))) + +(defun mastodon-tl--is-reply (toot) + "Check if the TOOT is a reply to another one (and not boosted). +Used as a predicate in `mastodon-tl--timeline'." + (and (mastodon-tl--field 'in_reply_to_id toot) + (eq :json-false (mastodon-tl--field 'reblogged toot)))) + +(defun mastodon-tl--filters-alist (filters) + "Parse filter data for FILTERS. +For each filter, return a list of action (warn or hide), filter +title, and context." + (cl-loop for x in filters ;; includes non filter elts! + for f = (alist-get 'filter x) + collect (list (alist-get 'filter_action f) + (alist-get 'title f) + (alist-get 'context f)))) + +(defun mastodon-tl--filter-by-context (context filters) + "Remove FILTERS that don't apply to the current CONTEXT." + (cl-remove-if-not + (lambda (x) + (member context (nth 2 x))) + filters)) + +(defun mastodon-tl--filters-context () + "Return a string of the current buffer's filter context. +Returns a member of `mastodon-views--filter-types'." + ;; FIXME: filters for bookmarks? = home? + (let ((buf (mastodon-tl--get-buffer-type))) + (cond ((or (eq buf 'local) (eq buf 'federated)) + "public") + ((mastodon-tl--profile-buffer-p) + "profile") + ( + ;; (eq buf 'list-timeline) + (or (eq buf 'list-timeline) (eq buf 'bookmarks)) + "home") ;; lists are "home" filter + (t ;; thread, notifs, home: + (symbol-name buf))))) + +(defun mastodon-tl--current-filters (filters) + "Return the filters from FILTERS data that apply in the current context. +For each filter, return a list of action (warn or hide), filter +title, and context." + (let ((context (mastodon-tl--filters-context)) + (filters-no-context (mastodon-tl--filters-alist filters))) + (mastodon-tl--filter-by-context context filters-no-context))) + +(defun mastodon-tl--toot (toot &optional detailed-p thread domain + unfolded no-byline cw-expanded) + "Format TOOT and insert it into the buffer. +DETAILED-P means display more detailed info. For now +this just means displaying toot client. +THREAD means the status will be displayed in a thread view. +When DOMAIN, force inclusion of user's domain in their handle. +UNFOLDED is a boolean meaning whether to unfold or fold item if foldable. +NO-BYLINE means just insert toot body, used for folding. +CW-EXPANDED means treat content warnings as unfolded." + (let* ((mastodon-tl--expand-content-warnings + (or cw-expanded mastodon-tl--expand-content-warnings)) + (filtered (mastodon-tl--field 'filtered toot)) + (filters (when filtered + (mastodon-tl--current-filters filtered))) + (spoiler-or-content (if-let* ((match (assoc "warn" filters))) + (mastodon-tl--spoiler toot (cadr match)) + (if (mastodon-tl--has-spoiler toot) + (mastodon-tl--spoiler toot) + (mastodon-tl--content toot))))) + (unless (or + ;; If any filters are "hide", then we hide, + ;; even though item may also have a "warn" filter: + (and filtered (assoc "hide" filters)) ;; no insert + ;; if account suspended, no-op: + ;; https://codeberg.org/martianh/mastodon.el/issues/753 + ;; a user found post in bookmarks from a suspended user, + ;; breaking loading of bookmarks, even though I suspect the + ;; server should not even send us such data: + (map-nested-elt toot '(account suspended))) + (mastodon-tl--insert-status + toot (mastodon-tl--clean-tabs-and-nl spoiler-or-content) + detailed-p thread domain unfolded no-byline cw-expanded)))) + +(defun mastodon-tl--timeline (toots &optional thread domain no-byline) + "Display each toot in TOOTS. +This function removes replies if user required. +THREAD means the status will be displayed in a thread view. +When DOMAIN, force inclusion of user's domain in their handle. +NO-BYLINE means just insert toot body, used for folding." + (let ((start-pos (point)) + (toots ;; hack to *not* filter replies on profiles: + (if (eq (mastodon-tl--get-buffer-type) 'profile-statuses) + toots + (if (or ; we were called via --more*: + (mastodon-tl--buffer-property 'hide-replies nil :no-error) + ;; loading a tl with a prefix arg: + (mastodon-tl--hide-replies-p current-prefix-arg)) + (cl-remove-if-not #'mastodon-tl--is-reply toots) + toots)))) + (cl-loop for toot in toots + do (mastodon-tl--toot toot nil thread domain nil no-byline)) + ;; media: + (when mastodon-tl--display-media-p + (mastodon-media--inline-images start-pos (point))) + (goto-char (point-min)))) + +;;; FOLDING + +(defun mastodon-tl--read-more-or-less (str cw invis) + "Return a read more or read less heading. +STR is an uppercase string, either MORE or LESS. +The heading is a link to toggle the fold status of the toot. +CW and INVIS are boolean values for the properties invisible and +mastodon-content-warning-body." + (let ((type (if (string= str "MORE") 'read-more 'read-less))) + (propertize + (mastodon-search--format-heading + (mastodon-tl--make-link (format "READ %s" str) type) + nil :no-newline) + 'mastodon-content-warning-body cw + 'invisible invis))) + +(defun mastodon-tl--fold-body (body) + "Fold toot BODY if it is very long. +Folding decided by `mastodon-tl--fold-toots-at-length'." + (let* ((invis (get-text-property (1- (length body)) 'invisible body)) + (cw (get-text-property (1- (length body)) + 'mastodon-content-warning-body body)) + (heading (mastodon-tl--read-more-or-less "MORE" cw invis)) + (display (concat (substring body 0 + mastodon-tl--fold-toots-at-length) + heading))) + (propertize display + 'read-more body))) + +(defun mastodon-tl--load-images-fold () + "Check for unloaded images on (un)fold and load if found." + (when mastodon-tl--display-media-p + (let ((prev-point + (save-excursion + (let ((pb (point))) + (mastodon-tl-goto-prev-item :norefresh) + ;; our prev-item implementation is awful, so we just check + ;; if we moved, if we didn't, assume we are first item, so + ;; return point-min and use it: + (if (eq (point) pb) + (point-min) + (point)))))) + (mastodon-media--inline-images prev-point (point))))) + +(defun mastodon-tl-unfold-post (&optional fold) + "Unfold the toot at point if it is folded (read-more). +FOLD means to fold it instead." + (interactive) + (let ((at-byline (mastodon-tl--property 'byline :no-move))) + (if (save-excursion + (when (not at-byline) + (mastodon-tl-goto-next-item)) + (not (mastodon-tl--property 'toot-foldable :no-move))) + (user-error "No foldable item at point?") + (let* ((inhibit-read-only t) + (body-range (mastodon-tl--find-property-range 'toot-body + (point) :backward)) + (cw-range (mastodon-tl--find-property-range + 'mastodon-content-warning-body + (point) :backward)) + (cw-invis (when cw-range + (get-text-property (car cw-range) 'invisible))) + (toot (mastodon-tl--property 'item-json :no-move)) + ;; `replace-region-contents' is much too slow, our hack from + ;; fedi.el is much simpler and much faster: + (beg (car body-range)) + (end (cdr body-range)) + (last-point (point)) + (point-after-fold (> last-point + (+ beg mastodon-tl--fold-toots-at-length)))) + ;; save-excursion here useless actually: + ;; FIXME: because point goes to top of item, the screen gets scrolled + ;; by insertion + (goto-char beg) + (delete-region beg end) + (delete-char 1) ;; prevent newlines accumulating + ;; insert toot body: + (mastodon-tl--toot toot nil nil nil (not fold) :no-byline + (unless cw-invis :cw-expanded)) ;; respect CW state + ;; set toot-folded prop on entire toot (not just body): + (let ((toot-range ;; post fold action range: + (mastodon-tl--find-property-range 'item-json + (point) :backward))) + (add-text-properties (car toot-range) + (cdr toot-range) + `(toot-folded ,fold))) + ;; load unfolded images maybe: + (mastodon-tl--load-images-fold) + ;; try to leave point somewhere sane: + (cond ((or at-byline + (and fold point-after-fold)) ;; point was in area now folded + (ignore-errors (forward-line -1)) ;; in case we are between + (mastodon-tl-goto-next-item)) ;; goto byline + (t + (goto-char last-point) + (when point-after-fold ;; point was in READ MORE heading: + (beginning-of-line)))) + (message (format "%s toot" (if fold "Fold" "Unfold"))))))) + +(defun mastodon-tl-fold-post () + "Fold post at point, if it is too long." + (interactive) + (mastodon-tl-unfold-post :fold)) + +(defun mastodon-tl-fold-post-toggle () + "Toggle the folding status of the toot at point." + (interactive) + (let* ((folded (mastodon-tl--property 'toot-folded :no-move))) + (mastodon-tl-unfold-post (not folded)))) + +;;; TOOT STATS + +;; calqued off mastodon-alt.el: +(defun mastodon-tl--toot-for-stats (&optional toot) + ;; FIXME: just use `mastodon-tl-toot-or-base'? + "Return the TOOT on which we want to extract stats. +If no TOOT is given, the one at point is considered." + (let* ((original-toot (or toot (get-text-property (point) 'item-json))) + (toot (or (alist-get 'status original-toot) + (when (alist-get 'type original-toot) + original-toot) + (alist-get 'reblog original-toot) + original-toot)) + (type (alist-get 'type (or toot)))) + (unless (member type '("follow" "follow_request")) + toot))) + +(defun mastodon-tl--toot-stats (toot) + "Return a right aligned string (using display align-to). +String is filled with TOOT statistics (boosts, favs, replies). +When the TOOT is a reblog (boost), statistics from reblogged +toots are returned. +To disable showing the stats, customize +`mastodon-tl--show-stats'." + (let-alist (mastodon-tl--toot-for-stats toot) + (let* ((faves-prop (propertize (format "%s" .favourites_count) + 'favourites-count .favourites_count)) + (boosts-prop (propertize (format "%s" .reblogs_count) + 'boosts-count .reblogs_count)) + (faves (format "%s %s" faves-prop (mastodon-tl--symbol 'favourite))) + (boosts (format "%s %s" boosts-prop (mastodon-tl--symbol 'boost))) + (replies (format "%s %s" .replies_count (mastodon-tl--symbol 'reply))) + (quotes (when .quotes_count + (format "%s %s" + (propertize (number-to-string .quotes_count) + 'face 'mastodon-toot-docs-face) + (propertize (mastodon-tl--symbol 'quote) + 'face '(:inherit success :box t))))) + (stats (concat + (propertize faves + 'favourited-p (eq t .favourited) + 'favourites-field t + 'help-echo (format "%s favourites" .favourites_count) + 'face 'mastodon-toot-docs-face) + (propertize " | " 'face 'mastodon-toot-docs-face) + (propertize boosts + 'boosted-p (eq t .reblogged) + 'boosts-field t + 'help-echo (format "%s boosts" .reblogs_count) + 'face 'mastodon-toot-docs-face) + (propertize " | " 'face 'mastodon-toot-docs-face) + (propertize replies + 'replies-field t + 'replies-count .replies_count + 'help-echo (format "%s replies" .replies_count) + 'face 'mastodon-toot-docs-face) + (propertize " | " 'face 'mastodon-toot-docs-face) + (when .quotes_count + (propertize quotes + 'quotes-field t + 'quotes-count .quotes_count + 'help-echo (format "%s quotes" .quotes_count) + ;; 'face 'mastodon-toot-docs-face + )))) + (right-spacing + (propertize " " + 'display + `(space :align-to (- right ,(+ (length stats) 7)))))) + (concat right-spacing stats)))) + + +;;; 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))) + + +;;; BUFFERS + +(defun mastodon-tl--endpoint-str-= (str &optional type) + "Return T if STR is equal to the current buffer's endpoint. +TYPE may be :prefix or :suffix, in which case, T if STR is a prefix or suffix." + (let ((endpoint-fun (mastodon-tl--endpoint nil :no-error))) + (cond ((eq type :prefix) + (string-prefix-p str endpoint-fun)) + ((eq type :suffix) + (string-suffix-p str endpoint-fun)) + (t + (string= str endpoint-fun))))) + +(defun mastodon-tl--get-buffer-type () + "Return a symbol descriptive of current mastodon buffer type. +Should work in all mastodon buffers. +Note that for many buffers, this requires `mastodon-tl--buffer-spec' +to be set. It is set for almost all buffers, but you still have to +call this function after it is set or use something else." + (let ((buffer-name (mastodon-tl--buffer-name nil :no-error))) + (cond (mastodon-toot-mode + ;; composing/editing (no buffer spec): + (if (string= "*edit toot*" (buffer-name)) + 'edit-toot + 'new-toot)) + ;; main timelines: + ((mastodon-tl--endpoint-str-= "timelines/home") + 'home) + ((string= "*mastodon-local*" buffer-name) + 'local) + ((mastodon-tl--endpoint-str-= "timelines/public") + 'federated) + ((mastodon-tl--endpoint-str-= "timelines/tag/" :prefix) + 'tag-timeline) + ((mastodon-tl--endpoint-str-= "timelines/list/" :prefix) + 'list-timeline) + ;; notifs: + ((string-suffix-p "mentions*" buffer-name) + 'mentions) + ((mastodon-tl--endpoint-str-= "notifications") + 'notifications) + ((mastodon-tl--endpoint-str-= "notifications/requests") + 'notification-requests) + ;; threads: + ((mastodon-tl--endpoint-str-= "context" :suffix) + 'thread) + ((mastodon-tl--endpoint-str-= "statuses" :prefix) + 'single-status) + ;; profiles: + ((mastodon-tl--profile-buffer-p) + (cond + ;; an own profile option is needlessly confusing e.g. for + ;; `mastodon-profile-account-view-cycle' + ;; profile note: + ((string-suffix-p "update-profile*" buffer-name) + 'update-profile-note) + ;; posts inc. boosts: + ((string-suffix-p "no-boosts*" buffer-name) + 'profile-statuses-no-boosts) + ((string-suffix-p "no-replies*" buffer-name) + 'profile-statuses-no-replies) + ((string-suffix-p "only-media*" buffer-name) + 'profile-statuses-only-media) + ((string-match-p "-tagged-" buffer-name) + 'profile-statuses-tagged) + ((mastodon-tl--endpoint-str-= "statuses" :suffix) + 'profile-statuses) + ;; profile followers + ((mastodon-tl--endpoint-str-= "followers" :suffix) + 'profile-followers) + ;; profile following + ((mastodon-tl--endpoint-str-= "following" :suffix) + 'profile-following))) + ((mastodon-tl--endpoint-str-= "preferences") + 'preferences) + ;; search + ((mastodon-tl--search-buffer-p) + (cond ((string= "accounts" (mastodon-search--buf-type)) + 'search-accounts) + ((string= "hashtags" (mastodon-search--buf-type)) + 'search-hashtags) + ((string= "statuses" (mastodon-search--buf-type)) + 'search-statuses))) + ;; trends + ((mastodon-tl--endpoint-str-= "trends/statuses") + 'trending-statuses) + ((mastodon-tl--endpoint-str-= "trends/tags") + 'trending-tags) + ((mastodon-tl--endpoint-str-= "trends/links") + 'trending-links) + ;; User's views: + ((mastodon-tl--endpoint-str-= "filters") + 'filters) + ((mastodon-tl--endpoint-str-= "lists") + 'lists) + ((mastodon-tl--endpoint-str-= "suggestions") + 'follow-suggestions) + ((mastodon-tl--endpoint-str-= "favourites") + 'favourites) + ((mastodon-tl--endpoint-str-= "bookmarks") + 'bookmarks) + ((mastodon-tl--endpoint-str-= "follow_requests") + 'follow-requests) + ((mastodon-tl--endpoint-str-= "scheduled_statuses") + 'scheduled-statuses) + ;; instance description + ((mastodon-tl--endpoint-str-= "instance") + 'instance-description) + ((string= "*mastodon-toot-edits*" buffer-name) + 'toot-edits) + ((string= "*masto-image*" (buffer-name)) + 'mastodon-image) + ((mastodon-tl--endpoint-str-= "timelines/link") + 'link-timeline) + ((mastodon-tl--endpoint-str-= "announcements") + 'announcements) + ;; followed hashtags + ((mastodon-tl--endpoint-str-= "followed_tags") + 'followed-hashtags)))) + +(defun mastodon-tl--buffer-type-eq (type) + "Return t if current buffer type is equal to symbol TYPE." + (eq (mastodon-tl--get-buffer-type) type)) + +(defun mastodon-tl--profile-buffer-p () + "Return t if current buffer is a profile buffer of any kind. +This includes the update profile note buffer, but not the preferences one." + (string-prefix-p "accounts" (mastodon-tl--endpoint nil :no-error))) + +(defun mastodon-tl--own-profile-buffer-p () + "Return t if we are viewing our own profile buffer. +We check that our account credientials id matches the endpoint id in the +buffer spec, which if in a profile buffer is of the form +\"accounts/$id/statuses\"." + (and (mastodon-tl--profile-buffer-p) + (let ((endpoint-id + (nth 1 + (split-string (mastodon-tl--endpoint) "/")))) + (string= (mastodon-auth--get-account-id) + endpoint-id)))) + +(defun mastodon-tl--search-buffer-p () + "T if current buffer is a search buffer." + (string-suffix-p "search" (mastodon-tl--endpoint nil :no-error))) + +(defun mastodon-tl--timeline-proper-p () + "Return non-nil if the current buffer is a \"proper\" timeline. +A proper timeline excludes notifications, threads, profiles, and +other toot buffers that aren't strictly mastodon timelines." + (let ((timeline-buffers + '(home federated local tag-timeline list-timeline profile-statuses))) + (member (mastodon-tl--get-buffer-type) timeline-buffers))) + +(defun mastodon-tl--hide-replies-p (&optional prefix) + "Return non-nil if replies should be hidden in the timeline. +We hide replies if user explictly set the +`mastodon-tl--hide-replies' or used PREFIX combination to open a +timeline." + (and (mastodon-tl--timeline-proper-p) ; Only if we are in a proper timeline + (or (mastodon-tl--buffer-property 'hide-replies nil :noerror) + mastodon-tl--hide-replies ; User configured to hide replies + (equal '(4) prefix)))) ; Timeline called with C-u prefix + + +;;; 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 "" "" 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)) + + +;;; THREADS + +(defun mastodon-tl-view-single-toot () + "View toot at point in a separate buffer." + (interactive) + (let ((id (mastodon-tl--property 'base-item-id))) + (mastodon-tl--single-toot id))) + +(defun mastodon-tl--single-toot (id) + "View toot in separate buffer. +ID is that of the toot to view." + (let* ((buffer (format "*mastodon-toot-%s*" id)) + (toot (mastodon-http--get-json + (mastodon-http--api (concat "statuses/" id))))) + (if (eq (caar toot) 'error) + (user-error "Error: %s" (cdar toot)) + (with-mastodon-buffer buffer #'mastodon-mode nil + (mastodon-tl--set-buffer-spec buffer (format "statuses/%s" id) + #'mastodon-tl--update-toot + ;; id for reload on reply: + nil nil nil nil id) + (mastodon-tl--toot toot :detailed-p) + (goto-char (point-min)) + (when mastodon-tl--display-media-p + (mastodon-media--inline-images (point-min) + (point-max))) + (mastodon-tl-goto-next-item :no-refresh))))) + +(defun mastodon-tl--update-toot (json) + "Call `mastodon-tl-single-toot' on id found in JSON." + (let ((id (alist-get 'id json))) + (mastodon-tl--single-toot id))) + +(defun mastodon-tl-view-whole-thread () + "From a thread view, view entire thread. +If you load a thread from a toot, only the branches containing +are displayed by default. Call this if you subsequently want to +view all branches of a thread." + (interactive) + (if (not (eq (mastodon-tl--get-buffer-type) 'thread)) + (user-error "You need to be viewing a thread to call this") + (goto-char (point-min)) + (let ((id (mastodon-tl--property 'base-item-id))) + (mastodon-tl--thread-do id)))) + +(defun mastodon-tl-return () + "Load user profile or thread of item at point. +If item at point is a follow or follow request, load user profile. +Else load thread." + (interactive) + (let ((notif (mastodon-tl--property 'notification-type))) + (if (or (equal "follow" notif) + (equal "follow_request" notif)) + (let* ((json (mastodon-tl--property 'item-json)) + (handle (alist-get 'acct json))) + (mastodon-profile-show-user handle)) + (mastodon-tl-thread)))) + +(defun mastodon-tl-thread () + "Open thread buffer for toot at point." + (interactive) + (if (not (eq 'toot (mastodon-tl--property 'item-type :no-move))) + (user-error "Looks like there's no toot at point?") + (mastodon-tl--thread-do))) + +(defun mastodon-tl--thread-do (&optional thread-id) + "Open thread buffer for toot at point or with THREAD-ID. +This is the non-interactive version, so we can call it +programmatically and not crash into +`mastodon-toot--with-toot-item'." + ;; this function's var must not be id as the above macro binds id and + ;; even if we provide the arg (e.g. url-lookup), the macro definition + ;; overrides it, making the optional arg unusable! + (let* ((id (or thread-id (mastodon-tl--property 'base-item-id :no-move))) + (type + (if (and (mastodon-tl--buffer-type-eq 'notifications) + mastodon-group-notifications) + (mastodon-tl--property 'notification-type) + (mastodon-tl--field 'type + (mastodon-tl--property 'item-json :no-move)))) + (unfolded-state (mastodon-tl--buffer-property 'thread-unfolded + (current-buffer) :noerror)) + (mastodon-tl--expand-content-warnings + ;; if reloading and thread was explicitly (un)folded, respect it: + (or (pcase unfolded-state + ('folded nil) + ('unfolded t) + (_ mastodon-tl--expand-content-warnings))))) + (if (or (string= type "follow_request") + (string= type "follow")) ; no can thread these + (user-error "No thread") + (let* ((endpoint (format "statuses/%s/context" id)) + (url (mastodon-http--api endpoint)) + (buffer (format "*mastodon-thread-%s*" id)) + (toot (mastodon-http--get-json ; refetch in case we just faved/boosted: + (mastodon-http--api (concat "statuses/" id)) + nil :silent)) + (context (mastodon-http--get-json url nil :silent))) + (if (eq (caar toot) 'error) + (user-error "Error: %s" (cdar toot)) + (when (member (alist-get 'type toot) '("reblog" "favourite")) + (setq toot (alist-get 'status toot))) + (if (not (< 0 (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))))) + ;; just print the lone toot: + (mastodon-tl--single-toot id) + ;; we have a thread: + (with-mastodon-buffer buffer #'mastodon-mode nil + (let ((marker (make-marker))) + (mastodon-tl--set-buffer-spec buffer endpoint + #'mastodon-tl--thread-do + nil nil nil nil id) + (when unfolded-state + (plist-put mastodon-tl--buffer-spec + 'thread-unfolded unfolded-state)) + (when-let* ((ancestors (alist-get 'ancestors context))) + (mastodon-tl--timeline ancestors :thread)) + (goto-char (point-max)) + (move-marker marker (point)) + ;; print re-fetched toot: + (mastodon-tl--toot toot :detailed-p :thread) + ;; inline images only for the toot + ;; (`mastodon-tl--timeline' handles the rest): + (when mastodon-tl--display-media-p + (mastodon-media--inline-images marker ;start-pos + (point))) + (when-let* ((descendants (alist-get 'descendants context))) + (mastodon-tl--timeline descendants :thread)) + ;; put point at the toot: + (goto-char (marker-position marker)) + (mastodon-tl-goto-next-item :no-refresh))))))))) + +(defun mastodon-tl-mute-thread () + "Mute the thread displayed in the current buffer. +Note that you can only (un)mute threads you have posted in." + (interactive) + (mastodon-tl--mute-or-unmute-thread)) + +(defun mastodon-tl-unmute-thread () + "Unmute the thread displayed in the current buffer. +Note that you can only (un)mute threads you have posted in." + (interactive) + (mastodon-tl--mute-or-unmute-thread :unmute)) + +(defun mastodon-tl--thread-parent-id () + "Return the ID of the top item in a thread." + (save-excursion + (mastodon-tl--goto-first-item) + (mastodon-tl--property 'base-item-id :no-move))) + +(defun mastodon-tl--mute-or-unmute-thread (&optional unmute) + "Mute a thread. +If UNMUTE, unmute it." + (let ((mute-str (if unmute "unmute" "mute"))) + (when (or (mastodon-tl--buffer-type-eq 'thread) + (mastodon-tl--buffer-type-eq 'notifications)) + (let* ((id + ;; the id for `mastodon-tl--user-in-thread-p' ought to be the + ;; top-level item: + (if (mastodon-tl--buffer-type-eq 'notifications) + (mastodon-tl--property 'base-item-id :no-move) + (mastodon-tl--thread-parent-id))) + (we-posted-p (mastodon-tl--user-in-thread-p id)) + (url (mastodon-http--api (format "statuses/%s/%s" id mute-str)))) + (if (not we-posted-p) + (user-error "You can only (un)mute a thread you have posted in") + (when (y-or-n-p (format "%s this thread? " mute-str)) + (let ((response (mastodon-http--post url))) + (mastodon-http--triage + response + (lambda (_) + (message (format "Thread %sd!" mute-str))))))))))) + +(defun mastodon-tl--map-account-id-from-toot (statuses) + "Return a list of the account IDs of the author of each toot in STATUSES." + (mapcar (lambda (status) + (map-nested-elt status '(account id))) + statuses)) + +(defun mastodon-tl--user-in-thread-p (id) + "Return non-nil if the logged-in user has posted to the current thread. +ID is that of the post the context is currently displayed for." + (let* ((context-json (mastodon-http--get-json + (mastodon-http--api (format "statuses/%s/context" id)) + nil :silent)) + (ancestors (alist-get 'ancestors context-json)) + (descendants (alist-get 'descendants context-json)) + (a-ids (mastodon-tl--map-account-id-from-toot ancestors)) + (d-ids (mastodon-tl--map-account-id-from-toot descendants))) + (or (member (mastodon-auth--get-account-id) a-ids) + (member (mastodon-auth--get-account-id) d-ids)))) + + +;;; FOLLOW/BLOCK/MUTE, ETC + +(defun mastodon-tl-follow-user (user-handle + &optional notify langs reblogs json) + "Query for USER-HANDLE from current status and follow that user. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts. +Can be called to toggle NOTIFY on users already being followed. +LANGS is an array parameters alist of languages to filer user's posts by. +REBLOGS is a boolean string like NOTIFY, enabling or disabling +display of the user's boosts in your timeline. +JSON is a flag arg for `mastodon-http--post'." + (interactive (list (mastodon-tl--user-handles-get "follow"))) + (mastodon-tl--do-if-item + (mastodon-tl--do-user-action-and-response + user-handle "follow" nil notify langs reblogs json))) + +(defun mastodon-tl-follow-user-by-handle (user-handle) + "Prompt for a USER-HANDLE and follow that user. +USER-HANDLE can also be a URL to a user profile page." + ;; code adapted from sachac: + ;; https://sachachua.com/dotemacs/index.html#mastodon. thanks sachac! + (interactive "MHandle: ") + (when (string-match "https?://\\(.+?\\)/\\(@.+\\)" user-handle) + (setq user-handle + ;; sachac's model doesn't work with local user handles in URL, + ;; meaning the search below will fail, so we use our own + ;; URL-to-handle function, modified for the purpose: + ;; (concat (match-string 2 user-handle) "@" (match-string 1 user-handle)))) + (mastodon-tl--userhandle-from-url user-handle))) + (let* ((account (mastodon-profile--search-account-by-handle + user-handle)) + (user-id (alist-get 'id account)) + (name (if (not (string-empty-p + (alist-get 'display_name account))) + (alist-get 'display_name account) + (alist-get 'username account))) + (url (mastodon-http--api (format "accounts/%s/%s" user-id "follow")))) + (if account + (mastodon-tl--do-user-action-function url name + (substring user-handle 1) "follow") + (user-error "Cannot find a user with handle %S" user-handle)))) + +;; TODO: make this action "enable/disable notifications" +(defun mastodon-tl-enable-notify-user-posts (user-handle) + "Query for USER-HANDLE and enable notifications when they post." + (interactive (list (mastodon-tl--user-handles-get "enable"))) + (mastodon-tl--do-if-item + (mastodon-tl-follow-user user-handle "true"))) + +(defun mastodon-tl-disable-notify-user-posts (user-handle) + "Query for USER-HANDLE and disable notifications when they post." + (interactive (list (mastodon-tl--user-handles-get "disable"))) + (mastodon-tl-follow-user user-handle "false")) + +(defun mastodon-tl-follow-user-disable-boosts (user-handle) + "Prompt for a USER-HANDLE, and disable display of boosts in home timeline. +If they are also not yet followed, follow them." + (interactive (list (mastodon-tl--user-handles-get "disable boosts"))) + (mastodon-tl-follow-user user-handle nil nil "false")) + +(defun mastodon-tl-follow-user-enable-boosts (user-handle) + "Prompt for a USER-HANDLE, and enable display of boosts in home timeline. +If they are also not yet followed, follow them. +You only need to call this if you have previously disabled +display of boosts." + (interactive (list (mastodon-tl--user-handles-get "enable boosts"))) + (mastodon-tl-follow-user user-handle nil nil "true")) + +(defun mastodon-tl-filter-user-user-posts-by-language (user-handle) + "Query for USER-HANDLE and filter display of their posts by language. +If they are not already followed, they will be too. +To be filtered, a post has to be marked as in the language given. +This may mean that you will not see posts that are in your +desired language if they are not marked as such (or as anything)." + (interactive (list (mastodon-tl--user-handles-get "filter by language"))) + (let ((langs (mastodon-tl--read-filter-langs))) + (mastodon-tl--do-if-item + (if (string= "" (cdar langs)) + (mastodon-tl-unfilter-user-languages user-handle) + (mastodon-tl-follow-user user-handle nil langs))))) + +(defun mastodon-tl-unfilter-user-languages (user-handle) + "Remove any language filters for USER-HANDLE. +This means you will receive posts of theirs marked as being in +any or no language." + (interactive (list (mastodon-tl--user-handles-get "filter by language"))) + (let ((langs "languages[]")) + (mastodon-tl--do-if-item + ;; we need "languages[]" as a param, with no "=" and not json-encoded as + ;; a string + (mastodon-tl-follow-user user-handle nil langs nil :raw)))) + +(defun mastodon-tl--read-filter-langs (&optional langs) + "Read language choices and return an alist array parameter. +LANGS is the accumulated array param alist if we re-run recursively." + (let* ((iso-const mastodon-iso-639-1) + (iso (cons '("None (all)" . "") iso-const)) + (langs-alist langs) + (choice (completing-read "Filter user's posts by language: " + iso))) + (when choice + (setq langs-alist + (push `("languages[]" . ,(alist-get choice iso + nil nil #'string=)) + langs-alist)) + (if (y-or-n-p "Filter by another language? ") + (mastodon-tl--read-filter-langs langs-alist) + langs-alist)))) + +(defun mastodon-tl-unfollow-user (user-handle) + "Query for USER-HANDLE from current status and unfollow that user." + (interactive (list (mastodon-tl--user-handles-get "unfollow"))) + (mastodon-tl--do-if-item + (mastodon-tl--do-user-action-and-response user-handle "unfollow" t))) + +(defun mastodon-tl-block-user (user-handle) + "Query for USER-HANDLE from current status and block that user." + (interactive (list (mastodon-tl--user-handles-get "block"))) + (mastodon-tl--do-if-item + (mastodon-tl--do-user-action-and-response user-handle "block"))) + +(defun mastodon-tl-unblock-user (user-handle) + "Query for USER-HANDLE from list of blocked users and unblock that user." + (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unblock"))) + (if (not user-handle) + (user-error "Looks like you have no blocks to unblock!") + (mastodon-tl--do-user-action-and-response user-handle "unblock" t))) + +(defun mastodon-tl-mute-user (user-handle) + "Query for USER-HANDLE from current status and mute that user." + (interactive (list (mastodon-tl--user-handles-get "mute"))) + (mastodon-tl--do-if-item + (mastodon-tl--do-user-action-and-response user-handle "mute"))) + +(defun mastodon-tl-unmute-user (user-handle) + "Query for USER-HANDLE from list of muted users and unmute that user." + (interactive (list (mastodon-tl--get-blocks-or-mutes-list "unmute"))) + (if (not user-handle) + (user-error "Looks like you have no mutes to unmute!") + (mastodon-tl--do-user-action-and-response user-handle "unmute" t))) + +(defun mastodon-tl-dm-user (user-handle) + "Query for USER-HANDLE from current status and compose a message to that user." + (interactive (list (mastodon-tl--user-handles-get "message"))) + (mastodon-tl--do-if-item + (mastodon-toot--compose-buffer (concat "@" user-handle)) + (setq mastodon-toot--visibility "direct") + (mastodon-toot--update-status-fields))) + +(defun mastodon-tl-read-handle-annotated (user-handles prompt) + "Read a handle from data USER-HANDLES with PROMPT. +Annotate the candidates with display name or user name." + (let* ((item-json (mastodon-profile--item-json)) + (notif-accts (mastodon-tl--property 'notification-accounts :nomove)) + (completion-extra-properties + `(:annotation-function + ,(lambda (cand) + (let ((user + (or + ;; mentions: + (mastodon-tl--find-user cand + (alist-get 'mentions + (mastodon-tl--toot-or-base item-json))) + ;; notifs: + (mastodon-tl--find-user cand notif-accts) + ;; booster/faver: + (when (string= cand + (map-nested-elt item-json + '(account acct))) + (alist-get 'account item-json)) + ;; author: + (let ((data (mastodon-tl--toot-or-base item-json))) + (when (string= cand + (map-nested-elt data + '(account acct))) + (alist-get 'account data)))))) + (when user + (concat + (propertize " " + 'display '(space :align-to 40)) + (propertize (or (alist-get 'display_name user) + (alist-get 'username user)) + 'face 'mastodon-display-name-face)))))))) + (completing-read prompt user-handles nil 'confirm))) + +(defun mastodon-tl--user-handles-get (action) + "Get the list of user-handles for ACTION from the current toot." + (mastodon-tl--do-if-item + (let ((user-handles + (cond + ((or ; follow suggests / search / foll requests compat: + (member (mastodon-tl--get-buffer-type) + '( follow-suggestions search follow-requests + ;; profile follows/followers but not statuses: + profile-followers profile-following))) + ;; fetch 'item-json: + (list (alist-get 'acct + (mastodon-tl--property 'item-json :no-move)))) + ;; profile view, point in profile details, poss no toots + ;; needed for e.g. gup.pe groups which show no toots publically: + ((and (mastodon-tl--profile-buffer-p) + (get-text-property (point) 'profile-json)) + (list (alist-get 'acct + (mastodon-profile--profile-json)))) + ;; (grouped) notifications: + ((member (mastodon-tl--get-buffer-type) '(mentions notifications)) + (append ;; those acting on item: + (cl-remove-duplicates + (cl-loop for a in (mastodon-tl--property + 'notification-accounts :no-move) + collect (alist-get 'acct a))) + ;; mentions in item: + (mastodon-profile--extract-users-handles + (mastodon-profile--item-json)))) + (t + (mastodon-profile--extract-users-handles + (mastodon-profile--item-json)))))) + (mastodon-tl-read-handle-annotated + user-handles + (cond ((or ; TODO: make this "enable/disable notifications" + (string= action "disable") + (string= action "enable")) + (format "%s notifications when user posts: " action)) + ((string-suffix-p "boosts" action) + (format "%s by user: " action)) + (t (format "Handle of user to %s: " action))))))) + +(defun mastodon-tl--find-user (handle data) + "Find user with HANDLE in DATA." + (cl-find-if + (lambda (entry) + (string= handle (alist-get 'acct entry))) + data)) + +(defun mastodon-tl--get-blocks-or-mutes-list (action) + "Fetch the list of accounts for ACTION from the server. +Action must be either \"unblock\" or \"unmute\"." + (let* ((endpoint (cond ((string= action "unblock") + "blocks") + ((string= action "unmute") + "mutes"))) + (url (mastodon-http--api endpoint)) + (json (mastodon-http--get-json url)) + (accts (mastodon-tl--map-alist 'acct json))) + (when accts + (completing-read (format "Handle of user to %s: " action) + accts nil :match)))) + +(defun mastodon-tl--do-user-action-and-response + (user-handle action &optional negp notify langs reblogs json) + "Do ACTION on user USER-HANDLE. +NEGP is whether the action involves un-doing something. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts. +NOTIFY is only non-nil when called by `mastodon-tl-follow-user'. +LANGS is an array parameters alist of languages to filer user's posts by. +REBLOGS is a boolean string like NOTIFY, enabling or disabling +display of the user's boosts in your timeline." + (let* ((account + (cond + (negp ;; unmuting/unblocking, use mute/block list + (mastodon-profile--search-account-by-handle user-handle)) + ;; (grouped) notifications: + ((member (mastodon-tl--get-buffer-type) + '(mentions notifications)) + (let ((accounts (mastodon-tl--property 'notification-accounts))) + (or (cl-some (lambda (x) + (when (string= user-handle (alist-get 'acct x)) + x)) + accounts) + (mastodon-profile--lookup-account-in-status + user-handle + (mastodon-profile--item-json))))) + (t + (mastodon-profile--lookup-account-in-status + user-handle + (if (mastodon-tl--profile-buffer-p) + ;; profile view, use 'profile-json as status: + (mastodon-profile--profile-json) + ;; muting/blocking, select from handles in current status + (mastodon-profile--item-json)))))) + (user-id (alist-get 'id account)) + (name (mastodon-tl--display-or-uname account)) + (args (cond (notify `(("notify" . ,notify))) + (langs langs) + (reblogs `(("reblogs" . ,reblogs))) + (t nil))) + (url (mastodon-http--api (format "accounts/%s/%s" user-id action)))) + (if (not account) + (user-error "Cannot find a user with handle %S" user-handle) + (when (or (string= action "follow") ;; y-or-n for all but follow + (y-or-n-p (format "%s user %s? " action name))) + (mastodon-tl--do-user-action-function + url name user-handle action notify args reblogs json))))) + +(defun mastodon-tl--do-user-action-function + (url name user-handle action &optional notify args reblogs json) + "Post ACTION on user NAME/USER-HANDLE to URL. +NOTIFY is either \"true\" or \"false\", and used when we have been called +by `mastodon-tl-follow-user' to enable or disable notifications. +ARGS is an alist of any parameters to send with the request." + (let ((response (mastodon-http--post url args nil nil json))) + (mastodon-http--triage + response + (lambda (response) + (let ((json (with-current-buffer response + (mastodon-http--process-json)))) + ;; TODO: when > if, with failure msg + (cond ((string= notify "true") + (when (eq t (alist-get 'notifying json)) + (message "Receiving notifications for user %s (@%s)!" + name user-handle))) + ((string= notify "false") + (when (eq :json-false (alist-get 'notifying json)) + (message "Not receiving notifications for user %s (@%s)!" + name user-handle))) + ((string= reblogs "true") + (when (eq t (alist-get 'showing_reblogs json)) + (message "Receiving boosts by user %s (@%s)!" + name user-handle))) + ((string= reblogs "false") + (when (eq :json-false (alist-get 'showing_reblogs json)) + (message "Not receiving boosts by user %s (@%s)!" + name user-handle))) + ((or (string= action "mute") + (string= action "unmute")) + (message "User %s (@%s) %sd!" name user-handle action)) + ((string= args "languages[]") + (message "User %s language filters removed!" name)) + ((assoc "languages[]" args #'string=) + (message "User %s filtered by language(s): %s" name + (mapconcat #'cdr args " "))) + ((not (or notify reblogs)) + (if (and (string= action "follow") + (eq t (alist-get 'requested json))) + (message "Follow requested for user %s (@%s)!" name user-handle) + (message "User %s (@%s) %sed!" name user-handle action))))))))) + +(defun mastodon-tl--get-domain-blocks () + "Return a list of current domain blocks." + (mastodon-http--get-json + (mastodon-http--api "domain_blocks"))) + +(defun mastodon-tl-block-domain () + "Read a domain and block it." + (interactive) + (let* ((domain (read-string "Block domain: ")) + (params `(("domain" . ,domain))) + (url (mastodon-http--api "domain_blocks")) + (resp (mastodon-http--post url params))) + (mastodon-http--triage + resp + (lambda (_) + (message "Domain blocked!"))))) + +(defun mastodon-tl-unblock-domain () + "Read a blocked domain and unblock it." + (interactive) + (let ((blocks (mastodon-tl--get-domain-blocks))) + (if (not blocks) + (user-error "No blocked domains?") + (let* ((domain (completing-read "Unblock domain: " + blocks)) + (params `(("domain" . ,domain))) + (url (mastodon-http--api "domain_blocks")) + (resp (mastodon-http--delete url params))) + (mastodon-http--triage + resp + (lambda (_) + (message "Domain unblocked!"))))))) + + +;; FOLLOW TAGS + +(defun mastodon-tl--get-tags-list () + "Return the list of tags of the toot at point." + (let* ((toot (mastodon-toot--base-toot-or-item-json)) + (tags (mastodon-tl--field 'tags toot))) + (mastodon-tl--map-alist 'name tags))) + +(defun mastodon-tl-follow-tag (&optional tag) + "Prompt for a tag (from post at point) and follow it. +If TAG provided, follow it." + (interactive) + (let* ((tags (unless tag (mastodon-tl--get-tags-list))) + (tag-at-point + (unless tag + (when (eq 'hashtag + (mastodon-tl--property 'mastodon-tab-stop :no-move)) + (mastodon-tl--property 'mastodon-tag :no-move)))) + (tag (or tag (completing-read + (format "Tag to follow [%s]: " tag-at-point) + tags nil nil nil nil tag-at-point))) + (url (mastodon-http--api (format "tags/%s/follow" tag))) + (response (mastodon-http--post url))) + (mastodon-http--triage response + (lambda (_) + (message "tag #%s followed!" tag))))) + +(defun mastodon-tl--followed-tags () + "Return JSON of tags followed." + (let ((url (mastodon-http--api (format "followed_tags")))) + (mastodon-http--get-json url))) + +(defun mastodon-tl-unfollow-tag (&optional tag) + "Prompt for a followed tag, and unfollow it. +If TAG is provided, unfollow it." + (interactive) + (let* ((followed-tags-json (unless tag (mastodon-tl--followed-tags))) + (tags (unless tag (mastodon-tl--map-alist 'name followed-tags-json))) + (tag (or tag (completing-read "Unfollow tag: " tags))) + (url (mastodon-http--api (format "tags/%s/unfollow" tag))) + (response (mastodon-http--post url))) + (mastodon-http--triage response + (lambda (_) + (message "tag #%s unfollowed!" tag))))) + +(defun mastodon-tl-jump-to-followed-tag (&optional prefix) + "Prompt for a followed tag and view its timeline. +PREFIX is sent to `mastodon-tl-get-tag-timeline', which see." + (interactive "p") + (let* ((followed-tags-json (mastodon-tl--followed-tags)) + (tags (mastodon-tl--map-alist 'name followed-tags-json)) + (tag (completing-read "Tag: " tags nil))) + (if (null tag) + (user-error "You have to follow some tags first") + (mastodon-tl-get-tag-timeline prefix tag)))) + +(defun mastodon-tl-list-followed-tags () + "List followed tags. View timeline of tag user choses. +PREFIX is sent to `mastodon-tl-get-tag-timeline', which see." + (interactive) + (let* ((json (mastodon-tl--followed-tags)) + (sorted (cl-sort json #'string-lessp + :key (lambda (x) + (downcase (alist-get 'name x))))) + (buf "*mastodon-followed-tags*")) + (if (null sorted) + (user-error "You have to follow some tags first") + (with-mastodon-buffer (get-buffer-create buf) + #'mastodon-mode nil + (mastodon-tl--set-buffer-spec + buf "followed_tags" #'mastodon-tl-list-followed-tags) + (mastodon-search--insert-heading "followed tags") + (insert "\n") + (mastodon-search--print-tags sorted) + (goto-char (point-min)))))) + +(defun mastodon-tl-followed-tags-timeline (&optional prefix) + "Open a timeline of multiple tags. +With a single PREFIX arg, only show posts with media. +With a double PREFIX arg, limit results to your own instance. +If `mastodon-tl--tag-timeline-tags' is set, use its tags, else +fetch followed tags and load the first four of them." + (interactive "p") + (let* ((followed-tags-json (mastodon-tl--followed-tags)) + (tags (or mastodon-tl--tag-timeline-tags + (mastodon-tl--map-alist 'name followed-tags-json)))) + (mastodon-tl--show-tag-timeline prefix tags))) + +(defun mastodon-tl-some-followed-tags-timeline (&optional prefix) + "Prompt for some tags, and open a timeline for them. +The suggestions are from followed tags, but any other tags are also allowed. +PREFIX is for `mastodon-tl--show-tag-timeline', which see." + (interactive "p") + (let* ((followed-tags-json (mastodon-tl--followed-tags)) + (tags (mastodon-tl--map-alist 'name followed-tags-json)) + (selection (completing-read-multiple + "Tags' timelines to view [TAB to view, comma to separate]: " + tags))) + (mastodon-tl--show-tag-timeline prefix selection))) + +(defcustom mastodon-tl--tags-groups nil + "A list containing lists of up to four tags each. +You can load a tag timeline list with one of these by calling +`mastodon-tl-tag-group-timeline'." + :group 'mastodon-tl + :type '(repeat (list string string string string))) + +(defun mastodon-tl-tag-group-timeline (&optional prefix) + "Load a timeline of a tag group from `mastodon-tl--tags-groups'. +PREFIX is for `mastodon-tl--show-tag-timeline', which see." + (interactive "P") + (if (not mastodon-tl--tags-groups) + (user-error + "Set `mastodon-tl--tags-groups' to view tag group timelines") + (let* ((list-strs (mapcar (lambda (x) + ;; cons of list-as-string and list: + (cons (prin1-to-string x) x)) + mastodon-tl--tags-groups)) + (choice (completing-read "Tag group: " list-strs)) + (choice-list (cdr (assoc choice list-strs #'equal)))) + (mastodon-tl--show-tag-timeline prefix choice-list)))) + + +;;; REPORT TO MODERATORS + +(defun mastodon-tl--instance-rules () + "Return the rules of the user's instance." + (let ((url (mastodon-http--api "instance/rules"))) + (mastodon-http--get-json url nil :silent))) + +(defun mastodon-tl--report-params (account toot) + "Query user and return report params alist. +ACCOUNT and TOOT are the data to use." + (let* ((account-id (alist-get 'id account)) + (comment (read-string "Add comment [optional]: ")) + (item-id (when (y-or-n-p "Also report status at point? ") + (mastodon-tl--item-id toot))) ; base toot if poss + (forward-p (when (y-or-n-p "Forward to remote admin? ") "true")) + (rules (when (y-or-n-p "Cite a rule broken? ") + (mastodon-tl--read-rules-ids))) + (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other")))) + (mastodon-tl--report-build-params account-id comment item-id + forward-p cat rules))) + +(defun mastodon-tl--report-build-params + (account-id comment item-id forward-p cat &optional rules) + "Build the parameters alist based on user responses. +ACCOUNT-ID, COMMENT, ITEM-ID, FORWARD-P, CAT, and RULES are all from +`mastodon-tl--report-params', which see." + (let ((params + `(("account_id" . ,account-id) + ,@(when comment `(("comment" . ,comment))) + ,@(when item-id `(("status_ids[]" . ,item-id))) + ,@(when forward-p `(("forward" . ,forward-p))) + ,@(when cat `(("category" . ,cat)))))) + (if (not rules) + params + (let ((alist + (mastodon-http--build-array-params-alist "rule_ids[]" rules))) + (append alist params))))) + +(defun mastodon-tl-report-to-mods () + "Report the author of the toot at point to your instance moderators. +Optionally report the toot at point, add a comment, cite rules +that have been broken, forward the report to the remove admin, +report the account for spam." + (interactive) + (mastodon-tl--do-if-item + (when (y-or-n-p "Report author of toot at point?") + (let* ((url (mastodon-http--api "reports")) + (toot (mastodon-tl--toot-or-base + (mastodon-tl--property 'item-json :no-move))) + (account (alist-get 'account toot)) + (handle (alist-get 'acct account)) + (params (mastodon-tl--report-params account toot)) + (response (mastodon-http--post url params))) + (mastodon-http--triage response + (lambda (_) + (message "User %s reported!" handle))))))) + +(defvar crm-separator) + +(defun mastodon-tl--map-rules-alist (rules) + "Convert RULES text and id fields into an alist." + (mastodon-tl--map-alist-vals-to-alist 'text 'id rules)) + +(defun mastodon-tl--read-rules-ids () + "Prompt for a list of instance rules and return a list of selected ids." + (let* ((rules (mastodon-tl--instance-rules)) + (alist (mastodon-tl--map-rules-alist rules)) + (crm-separator (replace-regexp-in-string "," "|" crm-separator)) + (choices (completing-read-multiple + "rules [TAB for options, | to separate]: " + alist nil t))) + (mapcar (lambda (x) + (alist-get x alist nil nil #'string=)) + choices))) + + +;;; UPDATING, etc. + +(defun mastodon-tl--no-json (json) + "Nil if JSON is nil or empty group notif data." + (if (and (mastodon-tl--buffer-type-eq 'notifications) + mastodon-group-notifications) + (mastodon-notifications--empty-group-json-p json) + (not json))) + +(defun mastodon-tl--more-json (endpoint id) + "Return JSON for timeline ENDPOINT before ID." + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url args))) + +(defun mastodon-tl--more-json-async + (endpoint id &optional params silent callback &rest cbargs) + "Return JSON for timeline ENDPOINT before ID. +Then run CALLBACK with arguments CBARGS. +PARAMS is used to send any parameters needed to correctly update +the current view. +Optionally make the request SILENT." + (let* ((args `(("max_id" . ,(mastodon-tl--as-string id)))) + (args (append args params)) + (url (mastodon-http--api + endpoint + (when (or (and mastodon-group-notifications + (string= endpoint "notifications")) + (string-suffix-p "search" endpoint)) + "v2")))) + (apply #'mastodon-http--get-json-async url args silent callback cbargs))) + +(defun mastodon-tl--more-json-async-offset (endpoint &optional params silent + callback &rest cbargs) + "Return JSON for ENDPOINT, using the \"offset\" query param. +This is used for pagination with endpoints that implement the +\"offset\" parameter, rather than using link-headers or +\"max_id\". +PARAMS are the update parameters, see +`mastodon-tl--update-params'. These (\"limit\" and \"offset\") +must be set in `mastodon-tl--buffer-spec' for pagination to work. +Then run CALLBACK with arguments CBARGS. +Optionally make the request SILENT." + (let* ((params (or params (mastodon-tl--update-params))) + (limit (string-to-number + (alist-get "limit" params nil nil #'string=))) + (offset (number-to-string + (+ limit ; limit + old offset = new offset + (string-to-number + (alist-get "offset" params nil nil #'string=))))) + (url (mastodon-http--api + endpoint + (when (string-suffix-p "search" endpoint) + "v2")))) + ;; increment: + (setf (alist-get "offset" params nil nil #'string=) offset) + (apply #'mastodon-http--get-json-async url params silent callback cbargs))) + +(defun mastodon-tl--updated-json (endpoint id &optional params) + "Return JSON for timeline ENDPOINT since ID. +PARAMS is used to send any parameters needed to correctly update +the current view. +VERSION is the API version to use, as grouped notifs use v2." + (let* ((args `(("since_id" . ,(mastodon-tl--as-string id)))) + (args (append args params)) + (url (mastodon-http--api + endpoint + (when (and mastodon-group-notifications + (string= endpoint "notifications")) + "v2")))) + (mastodon-http--get-json url args))) + +;; TODO: add this to new posts in some cases, e.g. in thread view. +(defun mastodon-tl--reload-timeline-or-profile (&optional pos) + "Reload the current timeline or profile page. +For use after e.g. deleting a toot. +POS is a number, where point will be placed. +Aims to respect any pagination in effect." + (let ((type (mastodon-tl--get-buffer-type)) + (max-id (mastodon-tl--buffer-property 'max-id nil :no-error))) + (cond ((eq type 'home) + (mastodon-tl-get-home-timeline nil max-id)) + ((eq type 'federated) + (mastodon-tl-get-federated-timeline nil nil max-id)) + ((eq type 'local) + (mastodon-tl-get-local-timeline nil max-id)) + ((eq type 'mentions) + (mastodon-notifications-get-mentions)) + ((eq type 'notifications) + (mastodon-notifications-get nil nil max-id)) + ((eq type 'profile-statuses-no-boosts) + ;; TODO: max-id arg needed here also + (mastodon-profile-open-statuses-no-reblogs)) + ((eq type 'profile-statuses) + (save-excursion + (goto-char (point-min)) + (mastodon-profile--make-author-buffer + ;; (mastodon-profile-get-toot-author max-id))) + (mastodon-profile--profile-json)))) + ((or (eq type 'single-status) + (eq type 'thread)) + (let ((id (mastodon-tl--buffer-property + 'thread-item-id (current-buffer) :no-error))) + (mastodon-tl--thread-do id)))) + ;; TODO: sends point to where point was in buffer. This is very rough; we + ;; may have removed an item , so the buffer will be smaller, point will + ;; end up past where we were, etc. + (when pos + (goto-char pos) + (mastodon-tl-goto-prev-item :no-refresh)))) + +(defun mastodon-tl--build-link-header-url (str) + "Return a URL from STR, an http Link header." + (let* ((split (split-string str "; ")) + (url-base (string-trim (car split) "<" ">")) + (param (cadr split))) + (concat url-base "&" param))) + +(defun mastodon-tl--use-link-header-p () + "Return t if we are in a view needing Link header pagination. +Currently this includes favourites, bookmarks, follow requests, +and profile pages when showing followers or accounts followed." + (or (mastodon-tl--buffer-type-eq 'favourites) + (mastodon-tl--buffer-type-eq 'bookmarks) + (mastodon-tl--buffer-type-eq 'profile-followers) + (mastodon-tl--buffer-type-eq 'profile-following) + (mastodon-tl--buffer-type-eq 'follow-requests))) + +(defun mastodon-tl--get-link-header-from-response (headers) + "Get http Link header from list of http HEADERS." + ;; pleroma uses "link", so case-insensitive match required: + (when-let* ((link-headers (alist-get "Link" headers nil nil #'cl-equalp))) + (split-string link-headers ", "))) + +(defun mastodon-tl--more () + "Append older toots to timeline, asynchronously." + (message "Loading...") + (if (mastodon-tl--use-link-header-p) + ;; link-header paginate: + ;; can't build a URL with --more-json-async, endpoint/id: + ;; ensure we have a "next" type here, otherwise the CAR will be the + ;; "prev" type! + (let ((link-header (mastodon-tl--link-header))) + (if (> 2 (length link-header)) + (user-error "No next page") + (let* ((next (car link-header)) + ;;(prev (cadr (mastodon-tl--link-header))) + (url (mastodon-tl--build-link-header-url next))) + (mastodon-http--get-response-async + url nil nil 'mastodon-tl--more* (current-buffer) (point) :headers)))) + (cond (;; no paginate + (or (mastodon-tl--buffer-type-eq 'follow-suggestions) + (mastodon-tl--buffer-type-eq 'filters) + (mastodon-tl--buffer-type-eq 'lists)) + (user-error "No more results")) + ;; offset paginate (search, trending, user lists, ...?): + ((or (string-prefix-p "*mastodon-trending-" (buffer-name)) + (mastodon-tl--search-buffer-p)) + (mastodon-tl--more-json-async-offset + (mastodon-tl--endpoint) + (mastodon-tl--update-params) nil + 'mastodon-tl--more* (current-buffer) (point))) + (t ;; max_id paginate (timelines, items with ids/timestamps): + (let ((max-id (mastodon-tl--oldest-id)) + (params (mastodon-tl--update-params))) + (mastodon-tl--more-json-async + (mastodon-tl--endpoint) + max-id params nil + 'mastodon-tl--more* + (current-buffer) (point) nil max-id)))))) + +(defun mastodon-tl--more* + (response buffer point-before &optional headers max-id) + "Append older toots to timeline, asynchronously. +Runs the timeline's update function on RESPONSE, in BUFFER. +When done, places point at POINT-BEFORE. +HEADERS is the http headers returned in the response, if any. +MAX-ID is the pagination parameter, a string. +UPDATE-PARAMS is from prev buffer spec, added to the new one." + (with-current-buffer buffer + (if (not response) + (user-error "No more results") + (let* ((inhibit-read-only t) + (json (if headers (car response) response)) + ;; FIXME: max-id pagination works for statuses only, not other + ;; search results pages: + (json (if (not (mastodon-tl--search-buffer-p)) + json + (let ((type (mastodon-search--buf-type))) + (cond ((string= "statuses" type) + (cdr ; avoid repeat of last status + (alist-get 'statuses response))) + ((string= "hashtags" type) + (alist-get 'hashtags response)) + ((string= "accounts" type) + (alist-get 'accounts response)))))) + (headers (when headers (cdr response))) + (link-header + (mastodon-tl--get-link-header-from-response headers)) + (buf-type (mastodon-tl--get-buffer-type)) + (notifs-p (or (eq buf-type 'notifications) + (eq buf-type 'mentions))) + (notif-type (when notifs-p + (mastodon-notifications--current-type)))) + (goto-char (point-max)) + (if (eq 'thread buf-type) + ;; if thread fully unfolded, respect it: + ;; if thread view, call --thread-do with parent ID + (progn (goto-char (point-min)) + (mastodon-tl-goto-next-item) + (mastodon-tl--thread-do) + (goto-char point-before) + (message "Loaded full thread.")) + (if (mastodon-tl--no-json json) + (user-error "No more results") + (if notifs-p + (mastodon-notifications--timeline json notif-type :update) + (funcall (mastodon-tl--update-function) json)) + (goto-char point-before) + ;; update buffer spec to new link-header or max-id: + ;; (other values should just remain as they were) + (mastodon-tl--set-buffer-spec + (mastodon-tl--buffer-name) + (mastodon-tl--endpoint) + (mastodon-tl--update-function) + link-header (mastodon-tl--update-params) + (mastodon-tl--hide-replies-p) max-id) + (message "Loading... done."))))))) + +(defun mastodon-tl--find-property-range (property start-point + &optional search-backwards) + "Return nil if no such range is found. +If PROPERTY is set at START-POINT returns a range around +START-POINT otherwise before/after START-POINT. +SEARCH-BACKWARDS determines whether we pick point +before (non-nil) or after (nil)" + (if (get-text-property start-point property) + ;; We are within a range, so look backwards for the start: + (cons (previous-single-property-change + (if (eq start-point (point-max)) start-point (1+ start-point)) + property nil (point-min)) + (next-single-property-change start-point property nil (point-max))) + (if search-backwards + (let* ((end (or (previous-single-property-change + (if (eq start-point (point-max)) + start-point + (1+ start-point)) + property) + ;; we may either be just before the range or there + ;; is nothing at all + (and (not (eq start-point (point-min))) + (get-text-property (1- start-point) property) + start-point))) + (start (and end (previous-single-property-change + end property nil (point-min))))) + (when end + (cons start end))) + (let* ((start (next-single-property-change start-point property)) + (end (and start (next-single-property-change + start property nil (point-max))))) + (when start + (cons start end)))))) + +(defun mastodon-tl--find-next-or-previous-property-range + (property start-point search-backwards) + "Find (start . end) property range after/before START-POINT. +Does so while PROPERTY is set to a consistent value (different +from the value at START-POINT if that is set). +Return nil if no such range exists. +If SEARCH-BACKWARDS is non-nil it find a region before +START-POINT otherwise after START-POINT." + (if (not (get-text-property start-point property)) + ;; If we are not within a range, we can just defer to + ;; mastodon-tl--find-property-range directly. + (mastodon-tl--find-property-range property start-point search-backwards) + ;; We are within a range, we need to start the search from + ;; before/after this range: + (let ((current-range + (mastodon-tl--find-property-range property start-point))) + (if search-backwards + (unless (eq (car current-range) (point-min)) + (mastodon-tl--find-property-range + property (1- (car current-range)) search-backwards)) + (unless (eq (cdr current-range) (point-max)) + (mastodon-tl--find-property-range + property (1+ (cdr current-range)) search-backwards)))))) + +(defun mastodon-tl--consider-timestamp-for-updates (timestamp) + "Take note that TIMESTAMP is used in buffer and ajust timers as needed. +This calculates the next time the text for TIMESTAMP will change +and may adjust existing or future timer runs should that time +before current plans to run the update function. +The adjustment is only made if it is significantly (a few +seconds) before the currently scheduled time. This helps reduce +the number of occasions where we schedule an update only to +schedule the next one on completion to be within a few seconds. +If relative timestamps are disabled (i.e. if +`mastodon-tl--enable-relative-timestamps' is nil), this is a +no-op." + (when mastodon-tl--enable-relative-timestamps + (let ((this-update (cdr (mastodon-tl--relative-time-details timestamp)))) + (when (time-less-p this-update + (time-subtract mastodon-tl--timestamp-next-update + (seconds-to-time 10))) + (setq mastodon-tl--timestamp-next-update this-update) + (when mastodon-tl--timestamp-update-timer + ;; We need to re-schedule for an earlier time + (cancel-timer mastodon-tl--timestamp-update-timer) + (setq mastodon-tl--timestamp-update-timer + (run-at-time (time-to-seconds (time-subtract this-update + (current-time))) + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) nil))))))) + +(defun mastodon-tl--update-timestamps-callback (buffer previous-marker) + "Update the next few timestamp displays in BUFFER. +Start searching for more timestamps from PREVIOUS-MARKER or +from the start if it is nil." + ;; only do things if the buffer hasn't been killed in the meantime + (when (and mastodon-tl--enable-relative-timestamps ; just in case + (buffer-live-p buffer)) + (save-excursion + (with-current-buffer buffer + (let ((previous-timestamp (if previous-marker + (marker-position previous-marker) + (point-min))) + (iteration 0) + next-timestamp-range) + (if previous-marker + ;; a follow-up call to process the next batch of timestamps. + ;; Release the marker to not slow things down. + (set-marker previous-marker nil) + ;; Otherwise this is a rew run, so let's initialize the next-run time. + (setq mastodon-tl--timestamp-next-update (time-add (current-time) + (seconds-to-time 300)) + mastodon-tl--timestamp-update-timer nil)) + (while (and (< iteration 5) + (setq next-timestamp-range + (mastodon-tl--find-property-range 'timestamp + previous-timestamp))) + (let* ((start (car next-timestamp-range)) + (end (cdr next-timestamp-range)) + (timestamp (get-text-property start 'timestamp)) + (current-display (get-text-property start 'display)) + (new-display (mastodon-tl--relative-time-description timestamp))) + (unless (string= current-display new-display) + (let ((inhibit-read-only t)) + (add-text-properties + start end + (list 'display + (mastodon-tl--relative-time-description timestamp))))) + (mastodon-tl--consider-timestamp-for-updates timestamp) + (setq iteration (1+ iteration) + previous-timestamp (1+ (cdr next-timestamp-range))))) + (if next-timestamp-range + ;; schedule the next batch from the previous location to + ;; start very soon in the future: + (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer + (copy-marker previous-timestamp)) + ;; otherwise we are done for now; schedule a new run for when needed + (setq mastodon-tl--timestamp-update-timer + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + buffer nil)))))))) + +(defun mastodon-tl--set-after-update-marker () + "Set `mastodon-tl--after-update-marker' to the after-update location. +This location is defined by a non-nil value of +`mastodon-tl-position-after-update'." + (if (not mastodon-tl-position-after-update) + (setq mastodon-tl--after-update-marker nil) + (let ((marker (make-marker))) + (set-marker marker + (cond + ((eq 'keep-point mastodon-tl-position-after-update) + (point)) + ((eq 'last-old-toot mastodon-tl-position-after-update) + (next-single-property-change + (or mastodon-tl--update-point (point-min)) + 'byline)) + (t + (error "Unknown mastodon-tl-position-after-update value %S" + mastodon-tl-position-after-update)))) + ;; Make the marker advance if text gets inserted there. + (set-marker-insertion-type marker t) + (setq mastodon-tl--after-update-marker marker)))) + +(defun mastodon-tl-update () + "Update timeline with new toots." + (interactive) + ;; FIXME: actually these buffers should just reload by calling their own + ;; load function (actually g is mostly mapped as such) + ;; well actually, g should be for reload, update is different. + (if (or (member (mastodon-tl--get-buffer-type) + '(trending-statuses + trending-tags + follow-suggestions + lists + filters + scheduled-statuses)) + (mastodon-tl--search-buffer-p)) + (user-error "Update not available in this view") + ;; FIXME: handle update for search and trending buffers + (let* ((endpoint (mastodon-tl--endpoint)) + (update-fun (mastodon-tl--update-function)) + (id (mastodon-tl--newest-id))) + ;; update a thread, without calling `mastodon-tl--updated-json': + (if (mastodon-tl--buffer-type-eq 'thread) + ;; load whole thread: + (progn (mastodon-tl--thread-do id) + (message "Loaded full thread.")) + (if (not id) ;; if e.g. notifs all cleared: + (user-error "No last id") + ;; update other timelines: + (let* ((params (mastodon-tl--update-params)) + (notifs-p + (eq update-fun 'mastodon-notifications--timeline)) + (json (mastodon-tl--updated-json + endpoint id params))) + (if (mastodon-tl--no-json json) + (user-error "Nothing to update") + (let ((inhibit-read-only t)) + (mastodon-tl--set-after-update-marker) + (goto-char (or mastodon-tl--update-point (point-min))) + (if notifs-p + (funcall update-fun json nil :update) + (funcall update-fun json)) + (if mastodon-tl--after-update-marker + (goto-char mastodon-tl--after-update-marker) + (mastodon-tl-goto-next-item)))))))))) + + +;;; LOADING TIMELINES + +(defun mastodon-tl--init + (buffer-name endpoint update-function &optional headers params + hide-replies instance no-byline) + "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. +UPDATE-FUNCTION is used to recieve more toots. +HEADERS means to also collect the response headers. Used for paginating +favourites and bookmarks. +PARAMS is any parameters to send with the request. +HIDE-REPLIES is a flag indicating if replies are hidden in the current buffer. +INSTANCE is a string of another instance domain we are displaying +a timeline from. +NO-BYLINE means just insert toot body, used for announcements." + (let ((url (if instance + (concat "https://" instance "/api/v1/" endpoint) + (mastodon-http--api endpoint))) + (buffer (concat "*mastodon-" buffer-name "*"))) + (funcall + (if headers + #'mastodon-http--get-response-async + #'mastodon-http--get-json-async) + url params nil ;; not silent + 'mastodon-tl--init* + buffer endpoint update-function headers params hide-replies + instance no-byline))) + +(defun mastodon-tl--init* + (response buffer endpoint update-function &optional headers + update-params hide-replies instance no-byline) + "Initialize BUFFER with timeline targeted by ENDPOINT. +UPDATE-FUNCTION is used to recieve more toots. +RESPONSE is the data returned from the server by +`mastodon-http--process-json', with arg HEADERS a cons cell of +JSON and http headers, without it just the JSON. +NO-BYLINE means just insert toot body, used for announcements." + (let ((json (if headers (car response) response))) + (cond ((not json) ; praying this is right here, else try "\n[]" + ;; this means that whatever tl was inited won't load, which is not + ;; always wanted, as sometimes you still need the page to load so + ;; you can be in eg mastodon-mode, have keymap, search etc. + (message "Looks like nothing returned from endpoint: %s" endpoint) + ;; if we are a new account, home tl may have nothing, but then + ;; this clause means we can never load mastodon.el at all! + ;; so as a fallback, load trending statuses: + ;; FIXME: this could possibly be a fallback for all timelines not + ;; just home? + (when (string= endpoint "timelines/home") + (mastodon-search-trending-statuses))) + ((eq (caar json) 'error) + (user-error "Looks like the server bugged out: \"%s\"" (cdar json))) + (t + (let* ((headers (when headers (cdr response))) + (link-header + (mastodon-tl--get-link-header-from-response headers))) + (with-mastodon-buffer buffer #'mastodon-mode nil + (mastodon-tl--set-buffer-spec + buffer endpoint update-function + link-header update-params hide-replies + ;; awful hack to fix multiple reloads: + (alist-get "max_id" update-params nil nil #'string=)) + (mastodon-tl--do-init json update-function instance no-byline))))))) + +(defun mastodon-tl--init-sync + (buffer-name endpoint update-function &optional note-type params + headers view-name binding-str endpoint-version) + "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. +UPDATE-FUNCTION is used to receive more toots. +Runs synchronously. +Optional arg NOTE-TYPE means only get that type of notification. +PARAMS is an alist of any params to include in the request. +HEADERS are any headers to send in the request. +VIEW-NAME is a string, to be used as a heading for the view. +BINDING-STR is a string explaining any bindins in the view, it can have +formatting for `substitute-command-keys'. +ENDPOINT-VERSION is a string, format Vx, e.g. V2." + ;; Used by `mastodon-notifications-get' and in views.el + (let* ((notes-params (when note-type + (mastodon-http--build-array-params-alist + "types[]" (list note-type)))) + (params (append notes-params params)) + (url (mastodon-http--api endpoint endpoint-version)) + (buffer (concat "*mastodon-" buffer-name "*")) + (response (mastodon-http--get-response url params)) + (json (car response)) + (headers (when headers (cdr response))) + (link-header (when headers + (mastodon-tl--get-link-header-from-response headers)))) + (with-mastodon-buffer buffer #'mastodon-mode nil + ;; insert view-name/ heading-str + (when view-name + (mastodon-search--insert-heading view-name)) + (when binding-str + (insert + (substitute-command-keys + (mastodon-tl--set-face (concat "[" binding-str "]\n\n") + 'mastodon-toot-docs-face)))) + (mastodon-tl--set-buffer-spec + buffer endpoint update-function + link-header params nil + ;; awful hack to fix multiple reloads: + (alist-get "max_id" params nil nil #'string=)) + (mastodon-tl--do-init json update-function nil nil note-type) + buffer))) + +(defun mastodon-tl--do-init (json update-fun &optional domain no-byline type) + "Utility function for `mastodon-tl--init*' and `mastodon-tl--init-sync'. +JSON is the data to call UPDATE-FUN on. +When DOMAIN, force inclusion of user's domain in their handle. +NO-BYLINE means just insert toot body, used for announcements. +TYPE is a notification type." + (remove-overlays) ; video overlays + (cond (domain ;; maybe our update-fun doesn't always have 3 args...: + (funcall update-fun json nil domain)) + (type (funcall update-fun json type)) ;; notif types + (no-byline (funcall update-fun json nil nil no-byline)) + (t (funcall update-fun json))) + (setq + ;; Initialize with a minimal interval; we re-scan at least once + ;; every 5 minutes to catch any timestamps we may have missed + mastodon-tl--timestamp-next-update (time-add (current-time) + (seconds-to-time 300))) + (setq mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil))) + (unless (mastodon-tl--profile-buffer-p) + (mastodon-tl--goto-first-item))) + +;;; NODEINFO + +(defun mastodon-tl--get-nodeinfo (instance &optional version) + "Return Nodeinfo data for INSTANCE, optionally for VERSION." + ;; NB: not in the API: + (let ((url (format "https://%s/nodeinfo/%s" instance (or version "2.0")))) + (mastodon-http--get-json url))) + +(defun mastodon-tl-nodeinfo-for-toot () + "Return Nodeinfo for toot at point. +Displays what software and version an instance is running. +Also the instances description and usage stats, etc. +Nodeinfo is a data standard for distributed social networks, see +https://nodeinfo.diaspora.software." + (interactive) + (let* ((item (mastodon-tl--property 'item-json)) + (url (mastodon-tl--field 'url item)) + (instance (url-host (url-generic-parse-url url))) + (data (mastodon-tl--get-nodeinfo instance))) + (when data ;; don't display empty message when fetching failed + (if (eq 'error (caar data)) + (user-error "Error: %s" (alist-get 'error data)) + (mastodon-tl--render-nodeinfo data))))) + +(defun mastodon-tl--render-nodeinfo (data) + "Render Nodeinfo DATA as message." + (let-alist data + (message + "%s" + (concat "Software: " + .software.name " " .software.version + (if (not .metadata) + "" + (concat + "\nInstance: " + .metadata.nodeName " " .metadata.nodeDescription)))))) + +;;; BOOKMARKS + +(require 'bookmark) + +(defun mastodon-tl--bookmark-handler (record) + "Jump to a bookmarked location in mastodon.el. +RECORD is the bookmark record." + (let ((id (bookmark-prop-get record 'id))) + ;; we need to handle thread and single toot for starters + (pop-to-buffer + (mastodon-tl--thread-do id)))) + +(defun mastodon-tl--bookmark-make-record () + "Return a bookmark record for the current mastodon buffer." + (let ((id (mastodon-tl--property 'item-id :no-move)) + (name (buffer-name))) + `(,name + (buf . ,name) + (id . ,id) + (handler . mastodon-tl--bookmark-handler)))) + +(add-hook 'mastodon-mode-hook + (lambda () + (setq-local bookmark-make-record-function + #'mastodon-tl--bookmark-make-record))) + +(provide 'mastodon-tl) +;;; mastodon-tl.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-toot.el b/elpa/mastodon-20260406.856/mastodon-toot.el new file mode 100644 index 00000000..3e1f5ae4 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-toot.el @@ -0,0 +1,2310 @@ +;;; 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 +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; Commentary: + +;; mastodon-toot.el supports POSTing status data to Mastodon. + +;;; Code: +(eval-when-compile (require 'subr-x)) + +(defvar mastodon-use-emojify) +(require 'emojify nil :noerror) +(declare-function emojify-insert-emoji "emojify") +(declare-function emojify-set-emoji-data "emojify") +(declare-function emojify-mode "emojify") +(declare-function emojify-emojis-each "emojify") +(defvar emojify-emojis-dir) +(defvar emojify-user-emojis) +(defvar emojify-emoji-styles) + +(require 'cl-lib) +(require 'persist) +(require 'mastodon-iso) +(require 'facemenu) +(require 'text-property-search) + +(eval-when-compile + (require 'mastodon-tl)) + +(defvar mastodon-instance-url) +(defvar mastodon-tl--buffer-spec) +(defvar mastodon-tl--enable-proportional-fonts) +(defvar mastodon-profile-account-settings) +(defvar mastodon-profile-acccount-preferences-data) +(defvar mastodon-profiles-quote-policy-types) + +(autoload 'iso8601-parse "iso8601") +(autoload 'ht-get "ht") +(autoload 'mastodon-auth--user-acct "mastodon-auth") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--build-array-params-alist "mastodon-http") +(autoload 'mastodon-http--delete "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--post-media-attachment "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--read-file-as-string "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-kill-window "mastodon") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile--fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-profile--get-source-pref "mastodon-profile") +(autoload 'mastodon-profile-show-user "mastodon-profile") +(autoload 'mastodon-profile--update-preference "mastodon-profile") +(autoload 'mastodon-search--search-accounts-query "mastodon-search") +(autoload 'mastodon-search--search-tags-query "mastodon-search") +(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--buffer-type-eq "mastodon-tl") +(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-tl-goto-next-item "mastodon-tl") +(autoload 'mastodon-tl--map-alist "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") +(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-tl--render-text "mastodon-tl") +(autoload 'mastodon-tl--set-buffer-spec "mastodon-tl") +(autoload 'mastodon-tl--symbol "mastodon-tl") +(autoload 'mastodon-tl--item-id "mastodon-tl") +(autoload 'mastodon-toot "mastodon") +(autoload 'mastodon-views-cancel-scheduled-toot "mastodon-views") +(autoload 'mastodon-views-view-scheduled-toots "mastodon-views") +(autoload 'org-read-date "org") +(autoload 'mastodon-tl--toot-or-base "mastodon-tl") +(autoload 'mastodon-profile--get-source-value "mastodon-toot") +(autoload 'mastodon-tl--get-buffer-type "mastodon-tl") +(autoload 'mastodon-tl--human-duration "mastodon-tl") +(autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") +(autoload 'mastodon-views--get-own-instance "mastodon-views") +(autoload 'mastodon-tl--image-trans-check "mastodon-tl") +(autoload 'mastodon-instance-data "mastodon") +(autoload 'mastodon-create-poll "mastodon-transient") +(autoload 'mastodon-tl--own-profile-buffer-p "mastodon-tl") +(autoload 'mastodon-tl--thread-do "mastodon-tl") + +;; for mastodon-toot-translate-toot-text +(autoload 'mastodon-tl--content "mastodon-tl") +(when (require 'lingva nil :no-error) + (declare-function lingva-translate "lingva")) + +(defgroup mastodon-toot nil + "Tooting in Mastodon." + :prefix "mastodon-toot-" + :group 'mastodon) + +(defcustom mastodon-toot--default-media-directory "~/" + "The default directory when prompting for a media file to upload." + :type 'string) + +(defcustom mastodon-toot--attachment-height 80 + "Height of the attached images preview in the toot draft buffer." + :type 'integer) + +(defcustom mastodon-toot--enable-completion t + "Whether to enable completion of mentions and hashtags. +Used for completion in toot compose buffer." + :type 'boolean) + +(defcustom mastodon-toot--use-company-for-completion nil + "Whether to enable company for completion. +When non-nil, `company-mode' is enabled in the toot compose +buffer, and mastodon completion backends are added to +`company-capf'. + +You need to install company yourself to use this." + :type 'boolean) + +(defcustom mastodon-toot--completion-style-for-mentions "all" + "The company completion style to use for mentions." + :type '(choice + (const :tag "off" nil) + (const :tag "following only" "following") + (const :tag "all users" "all"))) + +(defcustom mastodon-toot-display-orig-in-reply-buffer nil + "Display a copy of the toot replied to in the compose buffer." + :type 'boolean) + +(defcustom mastodon-toot-orig-in-reply-length 191 + ;; three lines of divider width: (- (* 3 67) (length " Reply to: ")) + "Length to crop toot replied to in the compose buffer to." + :type 'integer) + +(defcustom mastodon-toot--default-reply-visibility "public" + "Default visibility settings when replying. +If the original toot visibility is different we use the more restricted one." + :type '(choice + (const :tag "public" "public") + (const :tag "unlisted" "unlisted") + (const :tag "followers only" "private") + (const :tag "direct" "direct"))) + +(defcustom mastodon-toot--enable-custom-instance-emoji nil + "Whether to enable your instance's custom emoji by default." + :type 'boolean) + +(defcustom mastodon-toot--proportional-fonts-compose nil + "Nonnil to enable using proportional fonts in the compose buffer. +By default fixed width fonts are used." + :type '(boolean :tag "Enable using proportional rather than fixed \ +width fonts")) + +(defcustom mastodon-toot-poll-use-transient t + "Whether to use the transient menu to create a poll." + :type '(boolean)) + +(defvar-local mastodon-toot--content-warning nil + "The content warning of the current toot.") + +(defvar-local mastodon-toot--content-nsfw nil + "A flag indicating whether the toot should be marked as NSFW.") + +(defvar mastodon-toot-visibility-list + '(public unlisted private direct) + "A list of the available toot visibility settings.") + +(defvar mastodon-toot-visibility-settings-list + '("public" "unlisted" "private") + "A list of the available default toot visibility settings. +Like `mastodon-toot-visibility-list' but without direct.") + +(defvar-local mastodon-toot--visibility nil + "A string indicating the visibility of the toot being composed. +Valid values are \"direct\", \"private\" (followers-only), +\"unlisted\", and \"public\". + +This is determined by the account setting on the server. To +change the setting on the server, see +`mastodon-toot-set-default-visibility'.") + +(defvar-local mastodon-toot--media-attachments nil + "A list of the media attachments of the toot being composed.") + +(defvar-local mastodon-toot--media-attachment-ids nil + "A list of any media attachment ids of the toot being composed.") + +(defvar mastodon-toot-poll nil + "A plist of poll options for the toot being composed.") + +(defvar-local mastodon-toot--language nil + "The language of the toot being composed, in ISO 639 (two-letter).") + +(defvar-local mastodon-toot--scheduled-for nil + "An ISO 8601 timestamp that specifying when the post should be published. +Should be at least 5 minutes into the future.") + +(defvar-local mastodon-toot--scheduled-id nil + "The id of the scheduled post that we are now editing.") + +(defvar-local mastodon-toot--reply-to-id nil + "Buffer-local variable to hold the id of the toot being replied to.") + +(defvar-local mastodon-toot--edit-item-id nil + "The id of the toot being edited.") + +(defvar-local mastodon-toot-previous-window-config nil + "A list of window configuration prior to composing a toot. +Takes its form from `window-configuration-to-register'.") + +(defvar mastodon-toot--max-toot-chars nil + "The maximum allowed characters count for a single toot.") + +(defvar-local mastodon-toot-completions nil + "The data of completion candidates for the current completion at point.") + +(defvar mastodon-toot-current-toot-text nil + "The text of the toot being composed.") + +(defvar-local mastodon-toot-quote-policy nil + "The quote policy for the current toot.") + +(defvar-local mastodon-toot-quote-id nil) + +(persist-defvar mastodon-toot-draft-toots-list nil + "A list of toots that have been saved as drafts. +For the moment we just put all composed toots in here, as we want +to also capture toots that are \"sent\" but that don't successfully +send.") + + +;;; REGEXES + +(defvar mastodon-toot-handle-regex + (rx (group-n 2 ; include domain + (group-n 4 ; exclude domain + (| (any ?\( "\n" "\t" " ") bol) ; preceding things + ?@ ; first @ + (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; username + (? ?@ (* (not (any "\n" "\t" " "))))) ; optional domain + (| "'" word-boundary))) ; boundary or possessive + +(defvar mastodon-toot-tag-regex + (rx (| (any ?\( "\n" "\t" " ") bol) + (group-n 2 ?# (+ (any "_" "A-Z" "a-z" "0-9"))) + (| "'" word-boundary))) ; boundary or possessive + +(defvar mastodon-toot-emoji-regex + (rx (| (any ?\( "\n" "\t" " ") bol) + (group-n 2 ?: ; opening : + (+ (any "A-Z" "a-z" "0-9" "_")) + (? ?:)) ; closing : + word-boundary)) ; boundary + +(defvar mastodon-toot-url-regex + ;; adapted from ffap-url-regexp + (concat + "\\(?2:\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)" ; uri prefix + "[^ \n\t]*\\)" ; any old thing, that is, i.e. we allow invalid/unwise chars + ;; "[ .,:;!?]\\b")) + ;; "/" ; poss an ending slash? incompat with boundary end: + "\\>")) ; boundary end + + +;;; 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))) + + +;;; 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))) + + +;;; MODE MAP + +(defvar mastodon-toot-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'mastodon-toot-send) + (define-key map (kbd "C-c C-k") #'mastodon-toot-cancel) + (define-key map (kbd "C-c C-w") #'mastodon-toot-set-content-warning) + (define-key map (kbd "C-c C-n") #'mastodon-toot-toggle-nsfw) + (define-key map (kbd "C-c C-v") #'mastodon-toot-change-visibility) + (define-key map (kbd "C-c C-e") #'mastodon-toot-insert-emoji) + (define-key map (kbd "C-c C-a") #'mastodon-toot-attach-media) + (define-key map (kbd "C-c !") #'mastodon-toot-clear-all-attachments) + (define-key map (kbd "C-c C-p") #'mastodon-toot-create-poll) + (define-key map (kbd "C-c C-u") #'mastodon-toot-set-quote-policy) + (define-key map (kbd "C-c C-o") #'mastodon-toot-clear-poll) + (define-key map (kbd "C-c C-l") #'mastodon-toot-set-toot-language) + (define-key map (kbd "C-c C-s") #'mastodon-toot-schedule-toot) + map) + "Keymap for `mastodon-toot'.") + +(defun mastodon-toot-set-default-visibility () + "Set the default visibility for toots on the server." + (interactive) + (let ((vis (completing-read "Set default visibility to:" + mastodon-toot-visibility-list + nil t))) + (mastodon-profile--update-preference "privacy" vis :source))) + +(defun mastodon-toot--get-max-toot-chars (&optional no-toot) + "Fetch max_toot_chars from `mastodon-instance-url' asynchronously. +NO-TOOT means we are not calling from a toot buffer." + (mastodon-http--get-json-async + (mastodon-http--api "instance") + nil :silent + 'mastodon-toot--get-max-toot-chars-callback no-toot)) + +(defun mastodon-toot--get-max-toot-chars-callback (json-response + &optional no-toot) + "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer. +NO-TOOT means we are not calling from a toot buffer." + (let ((max-chars + (or (alist-get 'max_toot_chars json-response) + (alist-get 'max_characters ; some servers have this instead + (alist-get 'statuses + (alist-get 'configuration + json-response)))))) + (setq mastodon-toot--max-toot-chars max-chars) + (unless no-toot + (with-current-buffer "*new toot*" + (mastodon-toot--update-status-fields))))) + +(defun mastodon-toot--action-success (marker byline-region remove &optional json) + "Insert/remove the text MARKER with `success' face in byline. +BYLINE-REGION is a cons of start and end pos of the byline to be +modified. +Remove MARKER if REMOVE is non-nil, otherwise add it. +JSON is added to the string as its item-json." + (let ((inhibit-read-only t) + (bol (car byline-region)) + (eol (cdr byline-region)) + (at-byline-p (eq t (mastodon-tl--property 'byline :no-move)))) + (save-excursion + (when remove + (goto-char bol) + (beginning-of-line) ;; The marker is not part of the byline + (if (search-forward (format "(%s) " marker) eol :no-error) + (replace-match "") + (user-error "Oops: could not find marker '(%s)'" marker))) + (unless remove + (goto-char bol) + (insert + (propertize + (format "(%s) " + (propertize marker + 'face 'success)) + 'cursor-face 'mastodon-cursor-highlight-face + 'item-json json)))) ;; for (un)folding items + (when at-byline-p + ;; leave point after the marker: + (unless remove + ;; if point is inside the byline, back up first so + ;; we don't move to the following toot: + (beginning-of-line) + (forward-line -1) + (mastodon-tl-goto-next-item))))) + +(defun mastodon-toot--action (action callback) + "Take ACTION, a string, on toot at point, then execute CALLBACK. +Makes a POST request to the server. Used for favouriting, +boosting, or bookmarking toots." + (let* ((id (mastodon-tl--property 'base-item-id)) + (url (mastodon-http--api + (concat "statuses/" (mastodon-tl--as-string id) "/" action))) + (response (mastodon-http--post url))) + (mastodon-http--triage response callback))) + +(defun mastodon-toot--toggle-boost-or-favourite (action) + "Toggle boost or favourite of toot at point. +ACTION is a symbol, either `favourite' or `boost.'" + (mastodon-toot--with-toot-item + (let* ((n-type (mastodon-tl--property 'notification-type :no-move)) + (byline-region (mastodon-tl--find-property-range 'byline (point))) + (boost-p (eq action 'boost)) + (action-str (symbol-name action)) + (item-json (mastodon-tl--property 'item-json)) + (vis (mastodon-tl--field 'visibility item-json))) + (cond + ((not byline-region) + (user-error "Nothing to %s here?!?" action-str)) + ;; there's nothing wrong with faving/boosting own toots + ;; & nothing wrong with faving/boosting own toots from notifs, + ;; it boosts/faves the base toot, not the notif status + ((or (string= n-type "follow") + (string= n-type "follow_request")) + (user-error "Can't %s %s notifications" action n-type)) + ((and boost-p + (or (string= vis "direct") + (string= vis "private"))) + (user-error "Can't boost posts with visibility: %s" vis)) + (t + (let* ((boosted (when byline-region + (get-text-property (car byline-region) 'boosted-p))) + (faved (when byline-region + (get-text-property (car byline-region) 'favourited-p))) + (str-api (if boost-p "reblog" action-str)) + (action-str-api (mastodon-toot--str-negify str-api faved boosted + action)) + (action-pp (concat + (mastodon-toot--str-negify action-str faved boosted + action) + (if boost-p "ed" "d"))) + (remove-p (if boost-p boosted faved))) + (mastodon-toot--action + action-str-api + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (if boost-p + (list 'boosted-p (not boosted)) + (list 'favourited-p (not faved)))) + (mastodon-toot--update-stats-on-action action remove-p) + (mastodon-toot--action-success (mastodon-tl--symbol action) + byline-region remove-p item-json)) + (message "%s #%s" action-pp id))))))))) + +(defun mastodon-toot--str-negify (str faved boosted action) + "Add \"un\" to STR if item is already FAVED or BOOSTED. +ACTION is the action currently being taken." + (if (eq action 'boost) + (if boosted (concat "un" str) str) + (if faved + (concat "un" str) + str))) + +(defun mastodon-toot--update-stats-on-action (action &optional subtract) + "Increment the toot stats display upon ACTION. +ACTION is a symbol, either `favourite' or `boost'. +SUBTRACT means we are un-favouriting or unboosting, so we decrement." + (if (not (symbolp action)) + (error "Invalid argument: symbolp %s" action) + (let* ((count-prop (if (eq action 'favourite) + 'favourites-count + 'boosts-count)) + (count-range (mastodon-tl--find-property-range count-prop (point))) + (count (get-text-property (car count-range) count-prop)) + (inhibit-read-only 1)) + ;; TODO another way to implement this would be to async fetch counts again + ;; and re-display from count-properties + (add-text-properties (car count-range) + (cdr count-range) + (list 'display + (number-to-string + (mastodon-toot--inc-or-dec count subtract)) + ;; update the count prop + ;; we rely on this for any subsequent actions: + count-prop + (mastodon-toot--inc-or-dec count subtract)))))) + +(defun mastodon-toot-toggle-boost () + "Boost/unboost toot at `point'." + (interactive) + (mastodon-toot--toggle-boost-or-favourite 'boost)) + +(defun mastodon-toot-toggle-favourite () + "Favourite/unfavourite toot at `point'." + (interactive) + (mastodon-toot--toggle-boost-or-favourite 'favourite)) + +;; TODO maybe refactor into boost/fave fun +(defun mastodon-toot-toggle-bookmark () + "Bookmark or unbookmark toot at point." + (interactive) + (mastodon-toot--with-toot-item + (let* ((n-type (mastodon-tl--property 'notification-type :no-move)) + (byline-region (mastodon-tl--find-property-range 'byline (point))) + (bookmarked-p (when byline-region + (get-text-property (car byline-region) 'bookmarked-p))) + (action (if bookmarked-p "unbookmark" "bookmark"))) + (cond ((or (string= n-type "follow") + (string= n-type "follow_request")) + (user-error "Can't bookmark %s notifications" n-type)) + ((not byline-region) + (user-error "Nothing to %s here?!?" action)) + (t + (let* ((bookmark-str (mastodon-tl--symbol 'bookmark)) + (message (if bookmarked-p + "Bookmark removed!" + "Toot bookmarked!")) + (item-json (mastodon-tl--property 'item-json))) + (mastodon-toot--action + action + (lambda (_) + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'bookmarked-p (not bookmarked-p))) + (mastodon-toot--action-success bookmark-str + byline-region bookmarked-p item-json) + (message "%s #%s" message id)))))))))) + +(defun mastodon-toot-list-boosters () + "List the boosters of toot at point." + (interactive) + ;; use grouped notifs data if present: + ;; only send accounts as arg if type matches notif type we are acting + ;; on, to prevent showing accounts for a boost notif when asking for + ;; favers, and vice versa. + (let* ((type (mastodon-tl--property 'notification-type :no-move)) + (accounts (when (string= type "reblog") + (mastodon-tl--property 'notification-accounts :no-move)))) + (mastodon-toot--list-boosters-or-favers nil accounts))) + +(defun mastodon-toot-list-favouriters () + "List the favouriters of toot at point." + (interactive) + (let* ((type (mastodon-tl--property 'notification-type :no-move)) + (accounts (when (string= type "favourite") + (mastodon-tl--property 'notification-accounts :no-move)))) + (mastodon-toot--list-boosters-or-favers :favourite accounts))) + +(defun mastodon-toot--list-boosters-or-favers (&optional favourite accounts) + "List the favouriters or boosters of toot at point. +With FAVOURITE, list favouriters, else list boosters. +ACCOUNTS is notfications accounts if any." + (mastodon-toot--with-toot-item + (let* ((endpoint (unless accounts + (if favourite "favourited_by" "reblogged_by"))) + (url (unless accounts + (mastodon-http--api (format "statuses/%s/%s" id endpoint)))) + (params (unless accounts '(("limit" . "80")))) + (json (or accounts (mastodon-http--get-json url params)))) + (if (eq (caar json) 'error) + (user-error "%s (Status does not exist or is private)" + (alist-get 'error json)) + (let ((handles (mastodon-tl--map-alist 'acct json)) + (type-string (if favourite "Favouriters" "Boosters"))) + (if (not handles) + (user-error "Looks like this toot has no %s" type-string) + (let ((choice (completing-read + (format "%s (enter to view profile): " type-string) + handles nil t))) + (mastodon-profile-show-user choice)))))))) + +(defun mastodon-toot-copy-toot-url () + "Copy URL of toot at point. +If the toot is a fave/boost notification, copy the URL of the +base toot." + (interactive) + (let* ((url (mastodon-toot--toot-url))) + (kill-new url) + (message "Toot URL copied to the clipboard."))) + +(defun mastodon-toot-browse-toot-url () + "Browse URL of toot at point. +Note that this loads the version of the toot on the remote server, not +your own. +Calls `browse-url'." + (interactive) + (browse-url + (mastodon-toot--toot-url))) + +(defun mastodon-toot--toot-url () + "Return the URL of the base toot at point." + (let* ((toot (mastodon-toot--base-toot-or-item-json))) + (if (mastodon-tl--field 'reblog toot) + (alist-get 'url (alist-get 'reblog toot)) + (alist-get 'url toot)))) + +(defun mastodon-toot-copy-toot-text () + "Copy text of toot at point. +If the toot is a fave/boost notification, copy the text of the +base toot." + (interactive) + (let* ((toot (mastodon-toot--base-toot-or-item-json))) + (kill-new (mastodon-tl--content toot)) + (message "Toot content copied to the clipboard."))) + +(defun mastodon-toot-translate-toot-text () + "Translate text of toot at point. +Uses `lingva.el'." + (interactive) + (if mastodon-tl--buffer-spec + (if-let* ((toot (mastodon-tl--property 'item-json))) + (condition-case x + (lingva-translate nil + (mastodon-tl--content toot) + (when mastodon-tl--enable-proportional-fonts + t)) + (void-function + (user-error "Looks like you need to install lingva.el. Error: %s" + (error-message-string x)))) + (user-error "No toot to translate?")) + (user-error "No mastodon buffer?"))) + +(defun mastodon-toot--own-toot-p (toot) + "Check if TOOT is user's own, for deleting, editing, or pinning it." + ;; this check needs to allow acting on own toots displayed as boosts, so we + ;; call `mastodon-tl--toot-or-base'. + (let ((json (mastodon-tl--toot-or-base toot))) + (string= (alist-get 'acct (alist-get 'account json)) + (mastodon-auth--user-acct)))) + +(defun mastodon-toot-pin-toot-toggle () + "Pin or unpin user's toot at point." + (interactive) + (let* ((toot (mastodon-toot--base-toot-or-item-json)) + (pinnable-p (mastodon-toot--own-toot-p toot)) + (pinned-p (eq t (alist-get 'pinned toot))) + (action (if pinned-p "unpin" "pin")) + (msg (if pinned-p "unpinned" "pinned"))) + (if (not pinnable-p) + (user-error "You can only pin your own toots") + (when (y-or-n-p (format "%s this toot? " (capitalize action))) + (mastodon-toot--action + action + (lambda (_) + ;; let's only reload when in own profile view: + (when (mastodon-tl--own-profile-buffer-p) + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot %s!" msg))))))) + + +;;; DELETE, DRAFT, REDRAFT + +(defun mastodon-toot-delete-toot () + "Delete user's toot at point synchronously." + (interactive) + (mastodon-toot-delete-and-redraft-toot t)) + +;; TODO: handle media/poll for redrafting toots +(defun mastodon-toot-delete-and-redraft-toot (&optional no-redraft) + "Delete and redraft user's toot at point synchronously. +NO-REDRAFT means delete toot only." + (interactive) + (mastodon-toot--with-toot-item + (let* ((toot (mastodon-toot--base-toot-or-item-json)) + (url (mastodon-http--api (format "statuses/%s" id))) + (attachmentsp (mastodon-tl--field 'media_attachments toot)) + (pos (point))) + (let-alist toot + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only delete (and redraft) your own toots") + (when (y-or-n-p (if no-redraft + "Delete this toot? " + "Delete and redraft this toot? ")) + (let* ((params + (when (and attachmentsp + no-redraft + (y-or-n-p "Also delete toot's attachments?")) + `(("delete_media" . "true")))) + (response (mastodon-http--delete url params))) + (mastodon-http--triage + response + (lambda (_) + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile pos)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + .in_reply_to_id + .visibility + .spoiler_text))))))))))) + +(defun mastodon-toot--set-cw (&optional cw) + "Set content warning to CW if it is non-nil." + (unless (or (null cw) ; cw is nil for `mastodon-tl-dm-user' + (string-empty-p cw)) + (setq mastodon-toot--content-warning cw))) + + +;;; REDRAFT + +(defun mastodon-toot--redraft (response &optional reply-id toot-visibility + toot-cw) + "Opens a new toot compose buffer using values from RESPONSE buffer. +REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." + (with-current-buffer response + (let* ((response (mastodon-http--process-json)) + (content (alist-get 'text response))) + (mastodon-toot--compose-buffer) + (goto-char (point-max)) + (insert content) + ;; adopt reply-to-id, visibility and CW from deleted toot: + (mastodon-toot--set-toot-properties + reply-id toot-visibility toot-cw + ;; TODO set new lang/scheduled props here + nil)))) + +(defun mastodon-toot--set-toot-media-attachments (media) + "Set the media attachments variables. +MEDIA is the media_attachments data for a status from the server." + (mapcar (lambda (x) + (cl-pushnew (alist-get 'id x) + mastodon-toot--media-attachment-ids) + (cl-pushnew `((:contents . ,(mastodon-http--read-file-as-string + (alist-get 'url x) :url)) + (:description . ,(alist-get 'description x))) + mastodon-toot--media-attachments)) + media)) + +(defun mastodon-toot--set-toot-properties + (reply-id visibility cw lang + &optional scheduled scheduled-id media poll quote-id) + "Set the toot properties for the current redrafted or edited toot. +REPLY-ID, VISIBILITY, CW, SCHEDULED, and LANG are the properties to set. +MEDIA is the media_attachments data for a status from the server." + (with-current-buffer "*edit toot*" + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) + (setq mastodon-toot--visibility visibility) + (setq mastodon-toot--scheduled-for scheduled) + (setq mastodon-toot--scheduled-id scheduled-id) + (when (not (string-empty-p lang)) + (setq mastodon-toot--language lang)) + (mastodon-toot--set-cw cw) + (when media + (mastodon-toot--set-toot-media-attachments media)) + (when poll + (mastodon-toot--server-poll-to-local poll)) + (setq mastodon-toot-quote-id quote-id) + (mastodon-toot--refresh-attachments-display) + (mastodon-toot--update-status-fields))) + +(defun mastodon-toot--kill (&optional cancel) + "Kill `mastodon-toot-mode' buffer and window. +CANCEL means the toot was not sent, so we save the toot text as a draft." + (let ((prev-window-config mastodon-toot-previous-window-config)) + (unless (eq mastodon-toot-current-toot-text nil) + (when cancel + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test #'string=))) + ;; prevent some weird bug when cancelling a non-empty toot: + (delete #'mastodon-toot--save-toot-text after-change-functions) + (quit-window 'kill) + (mastodon-toot--restore-previous-window-config prev-window-config))) + +(defun mastodon-toot-cancel () + "Kill new-toot buffer/window. Does not POST content. +If toot is not empty, prompt to save text as a draft." + (interactive) + (when (and (not (mastodon-toot--empty-p)) + (y-or-n-p "Save draft toot?")) + (mastodon-toot-save-draft)) + (mastodon-toot--kill)) + +(defun mastodon-toot-save-draft () + "Save the current compose toot text as a draft. +Pushes `mastodon-toot-current-toot-text' to +`mastodon-toot-draft-toots-list'." + (interactive) + (unless (string= mastodon-toot-current-toot-text nil) + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'string=) + (message "Draft saved!"))) + +(defun mastodon-toot--empty-p (&optional text-only) + "Return t if toot has no text, attachments, or polls. +TEXT-ONLY means don't check for attachments or polls." + (and (if text-only + t + (and (not mastodon-toot--media-attachments) + (not mastodon-toot-poll))) + (string-empty-p (mastodon-tl--clean-tabs-and-nl + (mastodon-toot--remove-docs))))) + + +;;; EMOJIS + +(defun mastodon-toot-insert-emoji () + "Prompt to insert an emoji." + (interactive) + (if mastodon-use-emojify + (emojify-insert-emoji) + (call-interactively #'emoji-search))) ;; 29.1 + +(defun mastodon-toot--emoji-dir () + "Return the file path for the mastodon custom emojis directory." + (concat (expand-file-name emojify-emojis-dir) + "/mastodon-custom-emojis/")) + +(defun mastodon-toot-download-custom-emoji () + "Download `mastodon-instance-url's custom emoji. +Emoji images are stored in a subdir of `emojify-emojis-dir'. +To use the downloaded emoji, run `mastodon-toot-enable-custom-emoji'." + (interactive) + (let* ((url (mastodon-http--api "custom_emojis")) + (custom-emoji (mastodon-http--get-json url)) + (mastodon-custom-emoji-dir (mastodon-toot--emoji-dir))) + (if (not (file-directory-p emojify-emojis-dir)) + (user-error "Looks like you need to set up emojify first") + (unless (file-directory-p mastodon-custom-emoji-dir) + (make-directory mastodon-custom-emoji-dir nil)) ; no add parent + (cl-loop for x in custom-emoji + do (let ((url (alist-get 'url x)) + (shortcode (alist-get 'shortcode x))) + ;; skip anything that contains unexpected characters + (when (and url shortcode + (string-match-p "^[a-zA-Z0-9-_]+$" shortcode) + (string-match-p "^[a-zA-Z]+$" (file-name-extension url))) + (url-copy-file url + (concat mastodon-custom-emoji-dir + shortcode + "." + (file-name-extension url)) + t)))) + (message "Custom emoji for %s downloaded to %s" + mastodon-instance-url + mastodon-custom-emoji-dir)))) + +(defun mastodon-toot--collect-custom-emoji () + "Return a list of `mastodon-instance-url's custom emoji. +The list is formatted for `emojify-user-emojis', which see." + (let* ((mastodon-custom-emojis-dir (mastodon-toot--emoji-dir)) + (custom-emoji-files (directory-files mastodon-custom-emojis-dir + nil ; not full path + "^[^.]")) ; no dot files + mastodon-emojify-user-emojis) + (cl-loop for x in custom-emoji-files + do (push + `(,(concat ":" + (file-name-base x) ":") + . (("name" . ,(file-name-base x)) + ("image" . ,(concat mastodon-custom-emojis-dir x)) + ("style" . "github"))) + mastodon-emojify-user-emojis)) + (reverse mastodon-emojify-user-emojis))) + +(defun mastodon-toot-enable-custom-emoji () + "Add `mastodon-instance-url's custom emoji to `emojify'. +Custom emoji must first be downloaded with +`mastodon-toot-download-custom-emoji'. Custom emoji are appended +to `emojify-user-emojis', and the emoji data is updated." + (interactive) + (unless (file-exists-p (mastodon-toot--emoji-dir)) + (when (y-or-n-p "Looks like you haven't downloaded your + instance's custom emoji yet. Download now? ") + (mastodon-toot-download-custom-emoji))) + (let ((masto-emojis (mastodon-toot--collect-custom-emoji))) + (unless (cl-find (car masto-emojis) + emojify-user-emojis + :test #'equal) + (setq emojify-user-emojis + (append masto-emojis + emojify-user-emojis)) + ;; if already loaded, reload + (when (featurep 'emojify) + ;; we now only do this within the unless test above, as it is extremely + ;; slow and runs in `mastodon-mode-hook'. + (emojify-set-emoji-data))))) + +(defun mastodon-toot--remove-docs () + "Get the body of a toot from the current compose buffer." + (let ((header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min)))) + (string-trim-left + (buffer-substring (cdr header-region) (point-max))))) + +(defun mastodon-toot--build-poll-params () + "Return an alist of parameters for POSTing a poll status." + (if mastodon-toot-poll-use-transient + (let-alist mastodon-toot-poll + (append + (mastodon-http--build-array-params-alist + "poll[options][]" + (list .one .two .three .four)) + (list (cons "poll[expires_in]" .expiry) + (cons "poll[multiple]" .multi) + (cons "poll[hide_totals]" .hide)))) + (append + (mastodon-http--build-array-params-alist + "poll[options][]" + (plist-get mastodon-toot-poll :options)) + `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) + `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) + `(("poll[hide_totals]" . ,(symbol-name (plist-get mastodon-toot-poll :hide))))))) + + +;;; SEND TOOT FUNCTION + +(defun mastodon-toot-send () + "POST contents of new-toot buffer to fediverse instance and kill buffer. +If media items have been attached and uploaded with +`mastodon-toot-attach-media', they are attached to the toot. +If `mastodon-toot--edit-item-id' is non-nil, PUT contents to +instance to edit a toot." + (interactive) + (let* ((toot (mastodon-toot--remove-docs)) + (scheduled mastodon-toot--scheduled-for) + (scheduled-id mastodon-toot--scheduled-id) + (edit-id mastodon-toot--edit-item-id) + (endpoint (mastodon-http--api (if edit-id ; we are sending an edit: + (format "statuses/%s" edit-id) + "statuses"))) + (args-no-media + (append + `(("status" . ,toot) + ("in_reply_to_id" . ,mastodon-toot--reply-to-id) + ("visibility" . ,mastodon-toot--visibility) + ("sensitive" . ,(when mastodon-toot--content-nsfw + (symbol-name t))) + ("spoiler_text" . ,mastodon-toot--content-warning) + ("quote_approval_policy" . ,mastodon-toot-quote-policy) + ("language" . ,mastodon-toot--language) + ("quoted_status_id" . ,mastodon-toot-quote-id)) + ;; Pleroma instances can't handle null-valued + ;; scheduled_at args, so only add if non-nil + (when scheduled `(("scheduled_at" . ,scheduled))))) + (args-media (when mastodon-toot--media-attachment-ids + (mastodon-http--build-array-params-alist + "media_ids[]" + mastodon-toot--media-attachment-ids))) + (args-poll (when mastodon-toot-poll + (mastodon-toot--build-poll-params))) + ;; media || polls: + (args (if mastodon-toot--media-attachment-ids + (append args-media args-no-media) + (if mastodon-toot-poll + (append args-no-media args-poll) + args-no-media))) + (prev-window-config mastodon-toot-previous-window-config)) + (cond ((and mastodon-toot--media-attachment-ids + ;; make sure we have media args + ;; and the same num of ids as attachments + (or (not args-media) + (not (= (length mastodon-toot--media-attachments) + (length mastodon-toot--media-attachment-ids))))) + (user-error "Something is wrong with your uploads. Wait for them to complete or try again")) + ((and mastodon-toot--max-toot-chars + (> (mastodon-toot--count-toot-chars toot mastodon-toot--content-warning) + mastodon-toot--max-toot-chars)) + (user-error "Looks like your toot (inc. CW) is longer than that maximum allowed length")) + ;; polls must have text, so we use poll as flag for text-only + ;; check here: + ((mastodon-toot--empty-p mastodon-toot-poll) + (user-error "Empty toot. Cowardly refusing to post this")) + (t + (let ((response (funcall (if edit-id ; we are sending an edit: + #'mastodon-http--put + #'mastodon-http--post) + endpoint args))) + (mastodon-http--triage + response + (lambda (_) + ;; kill buffer: + (mastodon-toot--kill) + ;; nil our poll var: + (setq mastodon-toot-poll nil) + (message "Toot %s!" (if scheduled "scheduled" "toot")) + ;; cancel scheduled toot if we were editing it: + (when scheduled-id + (mastodon-views-cancel-scheduled-toot + scheduled-id :no-confirm)) + ;; window config: + (mastodon-toot--restore-previous-window-config prev-window-config) + ;; reload: - when we have been editing + ;; - when we are in thread view + ;; (we don't reload in every case as it can be slow and we + ;; may lose our place in a timeline.) + (let ((type (mastodon-tl--get-buffer-type))) + (when (or edit-id + (eq 'single-status type) + (eq 'thread type)) + (let ((pos (marker-position (cadr prev-window-config)))) + (mastodon-tl--reload-timeline-or-profile pos))))))))))) + + +;;; EDITING TOOTS: + +(defun mastodon-toot-edit-toot-at-point () + "Edit the user's toot at point." + (interactive) + (mastodon-toot--with-toot-item + (let ((toot (mastodon-toot--base-toot-or-item-json))) + (if (not (mastodon-toot--own-toot-p toot)) + (user-error "You can only edit your own toots") + (let* ((source (mastodon-toot--get-toot-source id)) + (content (alist-get 'text source)) + (source-cw (alist-get 'spoiler_text source)) + (quote (alist-get 'quote toot))) + (let-alist toot + (when (y-or-n-p "Edit this toot? ") + (mastodon-toot--compose-buffer nil .in_reply_to_id nil + content :edit) + (goto-char (point-max)) + ;; adopt reply-to-id, visibility, CW, language, and media: + (mastodon-toot--set-toot-properties + .in_reply_to_id .visibility source-cw .language nil nil + ;; maintain media order: + (reverse .media_attachments) .poll + (map-nested-elt quote '(quoted_status id))) + (setq mastodon-toot--edit-item-id id)))))))) + +(defun mastodon-toot--get-toot-source (id) + "Fetch the source JSON of toot with ID." + (let ((url (mastodon-http--api (format "/statuses/%s/source" id)))) + (mastodon-http--get-json url nil :silent))) + +(defun mastodon-toot--get-toot-edits (id) + "Return the edit history of toot with ID." + (let* ((url (mastodon-http--api (format "statuses/%s/history" id)))) + (mastodon-http--get-json url))) + +(defun mastodon-toot-view-toot-edits () + "View editing history of the toot at point in a popup buffer." + (interactive) + (let ((id (mastodon-tl--property 'base-item-id)) + (history (mastodon-tl--property 'edit-history)) ;; at byline + (buf "*mastodon-toot-edits*")) + (if (not history) + (user-error "No editing history for this toot") + (with-mastodon-buffer buf #'special-mode :other-window + (cl-loop for count from 1 + for x in history + do (insert (propertize (if (= count 1) + (format "%s [original]:\n" count) + (format "%s:\n" count)) + 'face 'mastodon-toot-docs-face) + (mastodon-toot--insert-toot-iter x) + "\n")) + (goto-char (point-min)) + (setq-local header-line-format + (propertize + (format "Edits to toot by %s:" + (alist-get 'username + (alist-get 'account (car history)))) + 'face 'mastodon-toot-docs-face)) + (mastodon-tl--set-buffer-spec (buffer-name (current-buffer)) + (format "statuses/%s/history" id) + nil))))) + +(defun mastodon-toot--insert-toot-iter (it) + "Insert iteration IT of toot." + (let ((content (alist-get 'content it))) + ;; TODO: handle polls, media + (mastodon-tl--render-text content))) + +(defun mastodon-toot--restore-previous-window-config (config) + "Restore the window CONFIG after killing the toot compose buffer. +Buffer-local variable `mastodon-toot-previous-window-config' holds the config." + (set-window-configuration (car config)) + (goto-char (cadr config))) + +(defun mastodon-toot--mentions-to-string (mentions) + "Apply `mastodon-toot--process-local' function to each mention in MENTIONS. +Remove empty string (self) from result and joins the sequence with whitespace." + (let ((mentions (remove "" + (mapcar #'mastodon-toot--process-local mentions)))) + (mapconcat #'identity mentions " "))) + +(defun mastodon-toot--process-local (acct) + "Add domain to local ACCT and replace the curent user name with \"\". +Mastodon requires the full @user@domain, even in the case of local accts. +eg. \"user\" -> \"@user@local.social\" (when local.social is the domain of the +`mastodon-instance-url'). +eg. \"yourusername\" -> \"\" +eg. \"feduser@fed.social\" -> \"@feduser@fed.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)))))) + + +;;; 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: `username@host.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))) + + +;;; 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)))) + + +;;; COMPOSE TOOT SETTINGS + +(defun mastodon-toot-set-content-warning () + "Set a content warning for the current toot." + (interactive) + (setq mastodon-toot--content-warning + (read-string "Warning: " mastodon-toot--content-warning)) + (mastodon-toot--update-status-fields)) + +(defun mastodon-toot-toggle-nsfw () + "Toggle `mastodon-toot--content-nsfw'." + (interactive) + (setq mastodon-toot--content-nsfw + (not mastodon-toot--content-nsfw)) + (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off")) + (mastodon-toot--update-status-fields)) + +(defun mastodon-toot-change-visibility (&optional arg) + "Change the current visibility to the next valid value. +With prefix ARG, read a visibility type in the minibuffer." + (interactive "P") + (if (mastodon-tl--buffer-type-eq 'edit-toot) + (user-error "You can't change visibility when editing toots") + (setq mastodon-toot--visibility + (if arg + (completing-read "Visibility: " + mastodon-toot-visibility-list) + (cond ((string= mastodon-toot--visibility "public") + "unlisted") + ((string= mastodon-toot--visibility "unlisted") + "private") + ((string= mastodon-toot--visibility "private") + "direct") + (t + "public")))) + (mastodon-toot--update-status-fields))) + +(defun mastodon-toot-set-toot-language () + "Prompt for a language and set `mastodon-toot--language'. +Return its two letter ISO 639 1 code." + (interactive) + (let* ((choice (completing-read "Language for this toot: " + mastodon-iso-639-1))) + (setq mastodon-toot--language + (alist-get choice mastodon-iso-639-1 nil nil #'string=)) + (message "Language set to %s" choice) + (mastodon-toot--update-status-fields))) + +(defun mastodon-toot-set-quote-policy () + "Set quote policy for the current toot." + (interactive) + (let* ((default (alist-get 'posting:default:quote_policy + (mastodon-http--get-json + (mastodon-http--api "preferences")))) + (choice (completing-read + (format "Quote policy for this toot [default: %s]" + default) + mastodon-profiles-quote-policy-types))) + (setq mastodon-toot-quote-policy choice) + (message (concat "Quote policy for this toot: " choice)) + (mastodon-toot--update-status-fields))) + + +;;; ATTACHMENTS + +(defun mastodon-toot--delete-attachments () + "Delete each attachment on the server. +Makes a DELETE request for each item in +`mastodon-toot--media-attachment-ids'." + (while mastodon-toot--media-attachment-ids + (let* ((id (pop mastodon-toot--media-attachment-ids)) + (url (mastodon-http--api + (format "media/%s" + id))) + (resp (mastodon-http--delete url))) + (mastodon-http--triage resp + (lambda (_resp) + (message "File %s deleted!" id)))))) + +(defun mastodon-toot-clear-all-attachments () + "Remove all attachments from a toot draft. +If user so chooses, also delete the files on the server." + (interactive) + (setq mastodon-toot--media-attachments nil) + (if (not (y-or-n-p "Also delete attachments on the server?")) + (setq mastodon-toot--media-attachment-ids nil) + (mastodon-toot--delete-attachments)) + (mastodon-toot--refresh-attachments-display) + (mastodon-toot--update-status-fields)) + +(defun mastodon-toot--get-instance-max-attachments () + "Return the maximum attachments from `mastodon-active-user's instance. +If that fails, return 4 as a fallback" + ;; FIXME: this likely various for other server types: + ;; pleroma doesn't advertise this on "api/v1/instance" (checked + ;; fe.disroot.org) + (or + (let ((config (alist-get 'statuses + (alist-get 'configuration + (mastodon-views--get-own-instance))))) + (alist-get 'max_media_attachments config)) + 4)) ; mastodon default as fallback + +(defun mastodon-toot-attach-media () + "Prompt for an attachment file. +A preview is displayed in the new toot buffer, and the file +is uploaded asynchronously using `mastodon-toot--upload-attached-media'. +File is actually attached to the toot upon posting." + (interactive) + (if mastodon-toot-quote-id + (user-error "You can't add attachments to quote toots") + (let ((file (read-file-name "Filename: ")) + (description (read-string "Description: ")) + (max-attachments (mastodon-toot--get-instance-max-attachments))) + (when (>= (length mastodon-toot--media-attachments) + max-attachments) + ;; warn + pop the oldest one: + (when (y-or-n-p + (format "Maximum attachments (%s) reached: remove first one?" + max-attachments)) + (pop mastodon-toot--media-attachments))) + (if (file-directory-p file) + (user-error "Looks like you chose a directory not a file") + (setq mastodon-toot--media-attachments + (nconc mastodon-toot--media-attachments + `(((:contents . ,(mastodon-http--read-file-as-string file)) + (:description . ,description) + (:filename . ,file))))) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media + (car (last mastodon-toot--media-attachments))))))) + +(defun mastodon-toot--attachment-descriptions () + "Return a list of image descriptions for current attachments." + (mastodon-tl--map-alist :description mastodon-toot--media-attachments)) + +(defun mastodon-toot--attachment-from-desc (desc) + "Return an attachment based on its description DESC." + (car + (cl-member-if (lambda (x) + (rassoc desc x)) + mastodon-toot--media-attachments))) + +(defun mastodon-toot-edit-media-description () + "Prompt for an attachment, and update its description." + (interactive) + (let* ((descs (mastodon-toot--attachment-descriptions)) + (choice (completing-read "Attachment: " descs nil :match)) + (attachment (mastodon-toot--attachment-from-desc choice)) + (desc-new (read-string "Description: " choice))) + (setf (alist-get :description attachment) + desc-new) + (mastodon-toot--refresh-attachments-display))) + +(defun mastodon-toot--upload-attached-media (attachment) + "Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'. +The item's id is added to `mastodon-toot--media-attachment-ids', +which is used to attach it to a toot when posting." + (let* ((filename (expand-file-name (alist-get :filename attachment))) + (caption (alist-get :description attachment)) + (url (concat mastodon-instance-url "/api/v2/media"))) + (message "Uploading %s... (please wait before starting further uploads)" + (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption))) + +(defun mastodon-toot--refresh-attachments-display () + "Update the display attachment previews in toot draft buffer." + (let ((inhibit-read-only t) + (attachments-region (mastodon-tl--find-property-range + 'toot-attachments (point-min))) + (display-specs (mastodon-toot--format-attachments))) + (dotimes (i (- (cdr attachments-region) (car attachments-region))) + (add-text-properties (+ i (car attachments-region)) + (+ i 1 (car attachments-region)) + (list 'display (or (nth i display-specs) "")))))) + +(defun mastodon-toot--format-attachments () + "Format the attachment previews for display in toot draft buffer." + (or + (let ((image-options (when (mastodon-tl--image-trans-check) + `(:height ,mastodon-toot--attachment-height)))) + (cl-loop for count from 1 + for att in mastodon-toot--media-attachments + nconc + (let* ((data (alist-get :contents att)) + (image (apply #'create-image data + (if (version< emacs-version "27.1") + (when image-options 'imagemagick) + nil) ; inbuilt scaling in 27.1 + t image-options)) + (desc (alist-get :description att))) + (list (format "\n %d: " count) + image + (format " \"%s\"" desc))))) + (list "None"))) + + +;;; POLL + +(defun mastodon-toot--fetch-max-poll-options (instance) + "Return the maximum number of poll options from JSON data INSTANCE." + (mastodon-toot--fetch-poll-field 'max_options instance)) + +(defun mastodon-toot--fetch-max-poll-option-chars (instance) + "Return the maximum number of characters a poll option may have. +INSTANCE is JSON." + (if (alist-get 'pleroma instance) + (mastodon-toot--fetch-poll-field 'max_option_chars instance) + (or (mastodon-toot--fetch-poll-field 'max_characters_per_option instance) + 50))) ; masto default + +(defun mastodon-toot--fetch-poll-field (field instance) + "Return FIELD from the poll settings from JSON data INSTANCE." + (let* ((polls (if (alist-get 'pleroma instance) + (alist-get 'poll_limits instance) + (alist-get 'polls + (alist-get 'configuration instance))))) + (alist-get field polls))) + +(defun mastodon-toot--read-poll-options-count (max) + "Read the user's choice of the number of options the poll should have. +MAX is the maximum number set by their instance." + (let ((number (read-number (format "Number of options [2-%s]: " max) 2))) + (if (> number max) + (user-error "You need to choose a number between 2 and %s" max) + number))) + +(defun mastodon-toot-create-poll () + "Prompt for new poll options and return as a list." + (interactive) + (cond (mastodon-toot-quote-id + (user-error "You can't add a poll to a quote toot")) + (mastodon-toot-poll-use-transient + (call-interactively #'mastodon-create-poll)) + (t (mastodon-toot--read-poll)))) + +(defun mastodon-toot--read-poll () + "Read poll options." + (let* ((instance (mastodon-instance-data)) + (max-options (mastodon-toot--fetch-max-poll-options instance)) + (count (mastodon-toot--read-poll-options-count max-options)) + (length (mastodon-toot--fetch-max-poll-option-chars instance)) + (multiple-p (y-or-n-p "Multiple choice? ")) + (options (mastodon-toot--read-poll-options count length)) + (hide-totals (y-or-n-p "Hide votes until poll ends? ")) + (expiry (mastodon-toot--read-poll-expiry)) + (expiry-str (cdr expiry)) + (expiry-human (car expiry))) + (setq mastodon-toot-poll + `( :options ,options :length ,length :expiry-readable ,expiry-human + :expiry ,expiry-str :multi ,multiple-p :hide ,hide-totals)) + (message "poll created!") + (mastodon-toot--update-status-fields))) + +(defun mastodon-toot--read-poll-options (count length) + "Read a list of options for poll with COUNT options. +LENGTH is the maximum character length allowed for a poll option." + (let* ((choices + (cl-loop for x from 1 to count + collect (read-string + (format "Poll option [%s/%s] [max %s chars]: " + x count length)))) + (longest (apply #'max (mapcar #'length choices)))) + (if (not (> longest length)) + choices + (user-error "Looks like you went over the max length. Try again") + (sleep-for 2) + (mastodon-toot--read-poll-options count length)))) + +(defun mastodon-toot--read-poll-expiry () + "Prompt for a poll expiry time. +Return a cons of a human readable string, and a seconds-from-now string." + ;; API requires this in seconds + (let* ((options (mastodon-toot--poll-expiry-options-alist)) + (response (completing-read "poll ends in [or enter seconds]: " + options nil 'confirm))) + (or (assoc response options #'string=) + (if (< (string-to-number response) 300) + (cons "5 minutes" (number-to-string (* 60 5))) ;; min 5 mins + (cons (format "%s seconds" response) response))))) + +(defun mastodon-toot--poll-expiry-options-alist () + "Return an alist of expiry options options in seconds." + `(("5 minutes" . ,(number-to-string (* 60 5))) + ("30 minutes" . ,(number-to-string (* 60 30))) + ("1 hour" . ,(number-to-string (* 60 60))) + ("6 hours" . ,(number-to-string (* 60 60 6))) + ("1 day" . ,(number-to-string (* 60 60 24))) + ("3 days" . ,(number-to-string (* 60 60 24 3))) + ("7 days" . ,(number-to-string (* 60 60 24 7))) + ("14 days" . ,(number-to-string (* 60 60 24 14))) + ("30 days" . ,(number-to-string (* 60 60 24 30))))) + +(defun mastodon-toot-clear-poll (&optional transient) + "Remove poll from toot compose buffer. +Sets `mastodon-toot-poll' to nil. +If TRANSIENT, we are called from a transient, so nil +`tp-transient-settings' too." + (interactive) + (let ((var (if transient + 'tp-transient-settings + 'mastodon-toot-poll))) + (if (not (symbol-value var)) + (user-error "No poll?") + (set var nil) + (when transient + (setq mastodon-toot-poll nil)) + (mastodon-toot--update-status-fields)))) + +(defun mastodon-toot--server-poll-to-local (json) + "Convert server poll data JSON to a `mastodon-toot-poll' plist." + (let-alist json + (let* ((expiry-seconds-rel + (time-to-seconds + (time-subtract + (encode-time + (parse-time-string .expires_at)) + (current-time)))) + (expiry-str (format-time-string "%s" expiry-seconds-rel)) + (expiry-human (car + (mastodon-tl--human-duration expiry-seconds-rel))) + (options (mastodon-tl--map-alist 'title .options)) + (multiple (if (eq :json-false .multiple) nil t))) + (if mastodon-toot-poll-use-transient + (setq mastodon-toot-poll + `((multi . ,multiple) + (expiry . ,expiry-str) + ;; (hide . ,hide) + (one . ,(nth 0 options)) + (two . ,(nth 1 options)) + (three . ,(nth 2 options)) + (four . ,(nth 3 options)))) + (setq mastodon-toot-poll + `( :options ,options :expiry-readable ,expiry-human + :expiry ,expiry-str :multi ,multiple)))))) + +;;; QUOTE + +(defvar mastodon-toot-quote-approval-user + '("automatic" "manual" "denied" "unknown")) + +(defvar mastodon-toot-quote-approval-auto-or-manual + '("public" "followers" "following" "unsupported_policy")) + +(defun mastodon-toot-quote () + "Compose a toot quoting the toot at point." + (interactive) + ;; boosted toot or toot: + (let* ((quote-id (mastodon-tl--property 'base-item-id)) + (json (mastodon-tl--property 'item-json)) + (policy (alist-get 'quote_approval json)) + (user-policy (alist-get 'current_user policy)) + ;; Respect visibility when quoting a toot: + ;; According to web UI settings (preferences/posting defaults): + + ;; - quoting an unlisted ("quiet public") post, means quoting post also unlisted + ;; "When people quote you, their post will also be hidden from trending timelines." + + ;; - private ("followers only") means no quoting allowed + ;; "Followers-only posts authored on Mastodon can't be quoted by others." + ;; BUT: we don't need to enforce this, as user-policy will be "denied" + ;; if toot is "private" + + ;; "Quoting a private post will restrict the quoting post’s + ;; visibility to private or direct (if the given visibility is + ;; public or unlisted, private will be used instead)." + + ;; + + ;; for now all we do is hand on quoted toot's visibility: + (visibility (mastodon-tl--field 'visibility json))) + (if (string= user-policy "denied") + (user-error "You don't have permission to quote this toot") + (when (or (not (string= user-policy "unknown")) + (y-or-n-p "Quote permission unknown. Proceed?")) + (mastodon-toot--compose-buffer nil nil nil nil nil + quote-id json visibility))))) + +(defun mastodon-toot-jump-to-quoting () + "Prompt for a toot quoting the toot at point and load it." + (interactive) + (mastodon-toot--with-toot-item + (let* ((json (mastodon-tl--toot-or-base + (mastodon-tl--property 'item-json))) + (quotes (alist-get 'quotes_count json))) + (if (= 0 quotes) + (user-error "Item has no quotes?") + ;; with-toot-item fetches base id: + (let* ((data (mastodon-toot--get-quoting id)) + (users (cl-loop for x in data + collect (map-nested-elt x '(account acct)))) + (completion-extra-properties + `(:annotation-function + ,(lambda (cand) + (let ((user (cl-find-if + (lambda (entry) + (string= cand + (map-nested-elt entry '(account acct)))) + data))) + (concat " " + (map-nested-elt user '(account username))))))) + (choice (completing-read "Load quoting toot by:" users)) + (choice-item (cl-find-if + (lambda (x) + (string= choice + (map-nested-elt x '(account acct)))) + data))) + (mastodon-tl--thread-do (alist-get 'id choice-item))))))) + +(defun mastodon-toot--get-quoting (id) + "Get statuses that quote item with ID." + ;; link header for paginating + ;; limit param default 20 max 40 + (let ((endpoint (mastodon-http--api + (format "statuses/%s/quotes" id)))) + (mastodon-http--get-json endpoint))) + + +;;; 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)))) + + +;;; DISPLAY KEYBINDINGS + +(defun mastodon-toot--get-kbinds () + "Get a list of the keybindings in the `mastodon-toot-mode'." + (let* ((binds (copy-tree mastodon-toot-mode-map)) + (prefix (car (cadr binds))) + (bindings (remove nil + (mapcar (lambda (i) + (when (listp i) i)) + (cadr binds))))) + (mapcar (lambda (b) + (setf (car b) (vector prefix (car b))) + b) + bindings))) + +(defun mastodon-toot--format-kbind-command (cmd) + "Format CMD to be more readable. +e.g. `mastodon-toot-send' -> Send." + (let* ((str (symbol-name cmd)) + (re "mastodon-toot-\\(.*\\)$") + (str2 (save-match-data + (string-match re str) + (match-string 1 str)))) + (capitalize (replace-regexp-in-string "-" " " str2)))) + +(defun mastodon-toot--format-kbind (kbind) + "Format a single keybinding, KBIND, for display in documentation." + (let ((key (concat "\\`" + (help-key-description (car kbind) nil) + "'")) + (command (mastodon-toot--format-kbind-command (cdr kbind)))) + (substitute-command-keys + (format + (concat (mastodon-toot--comment " ") + "%-10s" + (mastodon-toot--comment " - %s")) + key command)))) + +(defun mastodon-toot--comment (str) + "Propertize STR with `mastodon-toot-docs-face'." + (propertize str + 'face 'mastodon-toot-docs-face)) + +(defun mastodon-toot--format-kbinds (kbinds) + "Format a list of keybindings, KBINDS, for display in documentation." + (mapcar #'mastodon-toot--format-kbind kbinds)) + +(defvar-local mastodon-toot--kbinds-pairs nil + "Contains a list of paired toot compose buffer keybindings for inserting.") + +(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest) + "Return a list of strings each containing two formatted kbinds. +KBINDS-LIST is the list of formatted bindings to pair. +LONGEST is the length of the longest binding." + (when kbinds-list + (push (concat "\n" + (car kbinds-list) + (make-string (- (1+ longest) (length (car kbinds-list))) + ?\ ) + (cadr kbinds-list)) + mastodon-toot--kbinds-pairs) + (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest)) + (reverse mastodon-toot--kbinds-pairs)) + +(defun mastodon-toot--kbinds-longest (kbinds-list) + "Return the length of the longest item in KBINDS-LIST." + (let ((lengths (mapcar #'length kbinds-list))) + (car (sort lengths #'>)))) + + +;;; DISPLAY DOCS + +(defun mastodon-toot--make-mode-docs () + "Create formatted documentation text for `mastodon-toot-mode'." + (let* ((kbinds (mastodon-toot--get-kbinds)) + (formatted (mastodon-toot--format-kbinds kbinds)) + (longest-kbind (mastodon-toot--kbinds-longest + formatted))) + (concat + (mastodon-toot--comment + " Compose a new toot here. The following keybindings are available:") + (mapconcat + #'identity + (mastodon-toot--formatted-kbinds-pairs formatted longest-kbind) + nil)))) + +(defun mastodon-toot--format-reply-in-compose (reply-text &optional quote-text) + "Format a REPLY-TEXT for display in compose buffer docs. +Optionally format QUOTE-TEXT." + (let* ((rendered (mastodon-tl--render-text (or quote-text reply-text))) + (no-props (substring-no-properties rendered)) + ;; FIXME: this replaces \n at end of every post, so we have to trim: + (no-newlines (string-trim + (replace-regexp-in-string "[\n]+" " " no-props))) + (prompt (concat (if quote-text " Quoting: \"" " Reply to: \"") + no-newlines "\"")) + (crop (truncate-string-to-width + prompt mastodon-toot-orig-in-reply-length))) + (if (> (length no-newlines) + (length crop)) ; we cropped: + (concat crop "\n") + (concat prompt "\n")))) + +(defun mastodon-toot--display-docs-and-status-fields (&optional reply-text quote-text) + "Insert propertized text with documentation about `mastodon-toot-mode'. +Also includes and the status fields which will get updated based +on the status of NSFW, content warning flags, media attachments, etc. +REPLY-TEXT is the text of the toot being replied to. +QUOTE-TEXT is that of the toot being quoted if so." + (let ((divider + "|=================================================================|")) + (insert + (concat + (mastodon-toot--make-mode-docs) "\n" + (mastodon-toot--comment divider) "\n" + (propertize + (concat + " " + (propertize "Count" + 'toot-post-counter t) + " ⋅ " + (propertize "Visibility" + 'toot-post-visibility t) + " ⋅ " + (propertize "Language" + 'toot-post-language t) + " " + (propertize "Scheduled" + 'toot-post-scheduled t) + " " + (propertize "CW" + 'toot-post-cw-flag t) + " " + (propertize "POLL" + 'toot-post-poll-flag t) + " " + (propertize "NSFW" + 'toot-post-nsfw-flag t) + " " + (propertize "Quoting" + 'toot-quote-policy t) + "\n" + " Attachments: " + (propertize "None " + 'toot-attachments t) + "\n" + (cond (reply-text + (propertize + (mastodon-toot--format-reply-in-compose reply-text) + 'toot-reply t)) + (quote-text + (let ((text (mastodon-toot--format-reply-in-compose + nil quote-text))) + (propertize text + 'toot-quote text)))) + divider) + 'face 'mastodon-toot-docs-face + 'read-only "Edit your message below." + 'toot-post-header t)) + ;; allow us to enter text after read-only header: + (propertize "\n\n" + 'rear-nonsticky t)))) + +(defun mastodon-toot--most-restrictive-visibility (reply-visibility) + "Return REPLY-VISIBILITY or default visibility, whichever is more restrictive. +The default is given by `mastodon-toot--default-reply-visibility'." + (unless (null reply-visibility) + (let ((less-restrictive (member (intern mastodon-toot--default-reply-visibility) + mastodon-toot-visibility-list))) + (if (member (intern reply-visibility) less-restrictive) + reply-visibility + mastodon-toot--default-reply-visibility)))) + +(defun mastodon-toot--render-reply-region-str (str) + "Refill STR and prefix all lines with >, as reply-quote text." + (with-temp-buffer + (insert str) + ;; unfill first: + (let ((fill-column (point-max))) + (fill-region (point-min) (point-max))) + ;; then fill: + (fill-region (point-min) (point-max)) + ;; add our own prefix, pauschal: + (goto-char (point-min)) + (save-match-data + (while (re-search-forward "^" nil t) + (replace-match " > "))) + (buffer-substring-no-properties (point-min) (point-max)))) + +(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id + reply-json reply-region) + "If REPLY-TO-USER is provided, inject their handle into the message. +If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'. +REPLY-JSON is the full JSON of the toot being replied to. +REPLY-REGION is a string to be injected into the buffer." + (let ((reply-visibility (mastodon-toot--most-restrictive-visibility + (alist-get 'visibility reply-json))) + (reply-cw (alist-get 'spoiler_text reply-json))) + (when reply-to-user + (when (> (length reply-to-user) 0) ; self is "" unforch + (insert (format "%s " reply-to-user))) + (when reply-region + (insert "\n" + (mastodon-toot--render-reply-region-str reply-region) + "\n")) + (setq mastodon-toot--reply-to-id reply-to-id) + (unless (string= mastodon-toot--visibility reply-visibility) + (setq mastodon-toot--visibility reply-visibility)) + (mastodon-toot--set-cw reply-cw)))) + +(defun mastodon-toot--update-status-fields (&rest _args) + "Update the status fields in the header based on the current state." + (ignore-errors ;; called from after-change-functions so let's not leak errors + (let* ((inhibit-read-only t) + (header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'toot-post-counter + (point-min))) + (vis-region (mastodon-tl--find-property-range + 'toot-post-visibility (point-min))) + (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag + (point-min))) + (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag + (point-min))) + (lang-region (mastodon-tl--find-property-range 'toot-post-language + (point-min))) + (sched-region (mastodon-tl--find-property-range 'toot-post-scheduled + (point-min))) + (poll-region (mastodon-tl--find-property-range 'toot-post-poll-flag + (point-min))) + (quote-pol-region (mastodon-tl--find-property-range 'toot-quote-policy + (point-min))) + (toot-string (buffer-substring-no-properties (cdr header-region) + (point-max))) + (toot-quote (mastodon-tl--find-property-range 'toot-quote + (point-min))) + (quote-text (when toot-quote + (save-excursion + (goto-char (car toot-quote)) + (mastodon-tl--property 'toot-quote :nomove))))) + (mastodon-toot--apply-fields-props + count-region + (format "%s/%s chars" + (mastodon-toot--count-toot-chars toot-string) + (number-to-string mastodon-toot--max-toot-chars))) + (mastodon-toot--apply-fields-props + vis-region + (format "%s" + (if (string= "private" mastodon-toot--visibility) + "followers-only" + mastodon-toot--visibility))) + ;; WHEN clauses don't work here, we need "" as display arg: + (mastodon-toot--apply-fields-props + lang-region + (if mastodon-toot--language + (format "Lang: %s ⋅" mastodon-toot--language) + "")) + (mastodon-toot--apply-fields-props + sched-region + (if mastodon-toot--scheduled-for + (format "Scheduled: %s ⋅" + (mastodon-toot--iso-to-human + mastodon-toot--scheduled-for)) + "")) + (mastodon-toot--apply-fields-props + nsfw-region + (if mastodon-toot--content-nsfw + (if mastodon-toot--media-attachments + "NSFW" "NSFW (attachments only)") + "") + 'mastodon-cw-face) + (mastodon-toot--apply-fields-props + poll-region + (if mastodon-toot-poll + "POLL" + "") + 'mastodon-cw-face + (prin1-to-string mastodon-toot-poll)) + (mastodon-toot--apply-fields-props + cw-region + (if (and mastodon-toot--content-warning + (not (string= "" mastodon-toot--content-warning))) + (format "CW: %s" mastodon-toot--content-warning) + " ") ;; hold the blank space + 'mastodon-cw-face) + (mastodon-toot--apply-fields-props + quote-pol-region + (if mastodon-toot-quote-policy + (format "Quoting: %s" mastodon-toot-quote-policy) + "") + 'mastodon-cw-face) + (mastodon-toot--apply-fields-props + toot-quote quote-text 'mastodon-cw-face)))) + +(defun mastodon-toot--apply-fields-props (region display &optional face help-echo) + "Apply DISPLAY props FACE and HELP-ECHO to REGION, a cons of beg and end." + (add-text-properties (car region) (cdr region) + `(display + ,display + ,@(when face `(face ,face)) + ,@(when help-echo `(help-echo ,help-echo))))) + +(defun mastodon-toot--count-toot-chars (toot-string &optional cw) + "Count the characters in TOOT-STRING. +URLs always = 23, and domain names of handles are not counted. +This is how mastodon does it. +CW is the content warning, which contributes to the character count." + ;; FIXME: URL chars is avail at /api/v1/instance + ;; for masto, it's .statuses.characters_reserved_per_url + (let* ((url-replacement (make-string 23 ?x)) + (count-str + (replace-regexp-in-string ; handle @handles + mastodon-toot-handle-regex "\\4" + (replace-regexp-in-string ; handle URLs + mastodon-toot-url-regex url-replacement toot-string)))) + (+ (length cw) + (length count-str)))) + + +;;; 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!")) + + +;;; 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))))))) + + +;;; COMPOSE BUFFER FUNCTION + +(defun mastodon-toot--compose-buffer + (&optional reply-to-user reply-to-id reply-json initial-text edit + quote-id quote-json visibility) + "Create a new buffer to capture text for a new toot. +If REPLY-TO-USER is provided, inject their handle into the message. +If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var. +REPLY-JSON is the full JSON of the toot being replied to. +INITIAL-TEXT is used by `mastodon-toot-insert-draft-toot' to add +a draft into the buffer. +EDIT means we are editing an existing toot, not composing a new one. +QUOTE-ID is the id of the post being quoted if there is one. +QUOTE-JSON is its data. +VISIBILITY is the toot's visibility." + (let* ((buffer-name (if edit "*edit toot*" "*new toot*")) + (buffer-exists (get-buffer buffer-name)) + (buffer (if (not buffer-exists) + (get-buffer-create buffer-name) + ;; if a user hits reply while a compose buffer is already + ;; open, we really ought to wipe it all and start over. + (switch-to-buffer-other-window buffer-exists) + (if (not (y-or-n-p "Overwrite existing compose buffer?")) + (user-error "Aborting") + (kill-buffer-and-window) + (get-buffer-create buffer-name)))) + (inhibit-read-only t) + (reply-text (alist-get 'content + (or (alist-get 'reblog reply-json) + reply-json))) + (previous-window-config (list (current-window-configuration) + (point-marker)))) + (switch-to-buffer-other-window buffer) + (text-mode) + (mastodon-toot-mode t) + ;; set quote id: + (when quote-id + (setq mastodon-toot-quote-id quote-id)) + ;; set visibility: + (setq mastodon-toot--visibility + (or visibility ;; quoting a toot + (plist-get mastodon-profile-account-settings 'privacy) + ;; use toot visibility setting from the server: + (mastodon-profile--get-source-value 'privacy) + "public")) ; fallback + ;; default language: + ;; NB: this is not necessarily set in + ;; `mastodon-profile-credential-account' nor in + ;; `mastodon-profile-account-settings'! + (setq mastodon-toot--language + (mastodon-profile--get-preferences-pref 'posting:default:language)) + ;; display original toot: + (cond (quote-id + (mastodon-toot--display-docs-and-status-fields + nil (mastodon-tl--field 'content quote-json)) + (mastodon-toot--fill-reply-in-compose)) + (mastodon-toot-display-orig-in-reply-buffer + (mastodon-toot--display-docs-and-status-fields reply-text) + (mastodon-toot--fill-reply-in-compose)) + (t (mastodon-toot--display-docs-and-status-fields))) + ;; `reply-to-user' (alone) is also used by `mastodon-tl-dm-user', so + ;; perhaps we should not always call --setup-as-reply, or make its + ;; workings conditional on reply-to-id. currently it only checks for + ;; reply-to-user. + (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json + ;; only initial-text if reply (not edit): + (when reply-json initial-text)) + (unless mastodon-toot--max-toot-chars + ;; no need to fetch from `mastodon-profile-account-settings' as + ;; `mastodon-toot--max-toot-chars' is set when we set it + (mastodon-toot--get-max-toot-chars)) + ;; set up completion: + (setq-local completion-ignore-case t) + (when mastodon-toot--enable-completion + (set (make-local-variable 'completion-at-point-functions) + (add-to-list 'completion-at-point-functions + #'mastodon-toot--mentions-capf)) + (add-to-list 'completion-at-point-functions + #'mastodon-toot--tags-capf) + (add-to-list 'completion-at-point-functions + #'mastodon-toot--emoji-capf) + ;; company + (when (and mastodon-toot--use-company-for-completion + (require 'company nil :no-error)) + (declare-function company-mode-on "company") + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'company-capf)) + (company-mode-on))) + ;; after-change: + (make-local-variable 'after-change-functions) + (cl-pushnew #'mastodon-toot--save-toot-text after-change-functions) + (cl-pushnew #'mastodon-toot--update-status-fields after-change-functions) + (mastodon-toot--update-status-fields) + (cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions) + (mastodon-toot--propertize-tags-and-handles) + (mastodon-toot--refresh-attachments-display) + ;; draft toot text saving: + (setq mastodon-toot-current-toot-text nil) + ;; if we set this before changing modes, it gets nuked: + (setq mastodon-toot-previous-window-config previous-window-config) + (when mastodon-toot--proportional-fonts-compose + (facemenu-set-face 'variable-pitch)) + (when (and mastodon-use-emojify + ;; emojify loaded but poss not enabled in our buffer: + (boundp 'emojify-mode)) + (emojify-mode)) + (when (and initial-text + (not reply-json)) + (insert initial-text)))) + +;; flyspell ignore masto toot regexes: +(defvar flyspell-generic-check-word-predicate) + +(defun mastodon-toot-mode-flyspell-verify () + "A predicate function for `flyspell'. +Only text that is not one of these faces will be spell-checked." + (let ((faces '(mastodon-display-name-face + mastodon-toot-docs-face font-lock-comment-face + success link))) + (unless (eql (point) (point-min)) + ;; (point) is next char after the word. Must check one char before. + (let ((f (get-text-property (1- (point)) 'face))) + (not (memq f faces)))))) + +(defun mastodon-toot-mode-hook-fun () + "Function for code to run in `mastodon-toot-mode-hook'." + ;; disable auto-fill-mode: + (auto-fill-mode -1) + ;; add flyspell predicate function: + (setq flyspell-generic-check-word-predicate + #'mastodon-toot-mode-flyspell-verify)) + +(add-hook 'mastodon-toot-mode-hook #'mastodon-toot-mode-hook-fun) + +;;;###autoload +(add-hook 'mastodon-toot-mode-hook + #'mastodon-profile--fetch-server-account-settings-maybe) + + +(define-minor-mode mastodon-toot-mode + "Minor mode for composing toots." + :keymap mastodon-toot-mode-map + :global nil) + +(provide 'mastodon-toot) +;;; mastodon-toot.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-transient.el b/elpa/mastodon-20260406.856/mastodon-transient.el new file mode 100644 index 00000000..dbfb182e --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-transient.el @@ -0,0 +1,506 @@ +;;; mastodon-transient.el --- transient menus for mastodon.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 martian hiatus + +;; Author: martian hiatus +;; 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 . + +;;; Commentary: + +;; + +;;; Code: + +(require 'transient) +(require 'tp) + +(defvar mastodon-active-user) +(defvar mastodon-toot-visibility-settings-list) +(defvar mastodon-iso-639-regional) +(defvar mastodon-toot-poll) + +(autoload 'mastodon-toot-visibility-settings-list "mastodon-toot") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-http--patch "mastodon-http") +(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile") +(autoload 'mastodon-toot--fetch-max-poll-options "mastodon-toot") +(autoload 'mastodon-toot--fetch-max-poll-option-chars "mastodon-toot") +(autoload 'mastodon-instance-data "mastodon") +(autoload 'mastodon-toot--update-status-fields "mastodon-toot") +(autoload 'mastodon-toot--read-poll-expiry "mastodon-toot") +(autoload 'mastodon-toot--poll-expiry-options-alist "mastodon-toot") +(autoload 'mastodon-toot-clear-poll "mastodon-toot") +(autoload 'mastodon-notifications-get-policy "mastodon-notifications") + +;;; UTILS + +(transient-define-suffix mastodon-transient--prefix-inspect () + "Inspect a transient prefix's arguments and scope." + (interactive) + :transient 'transient--do-return + (let ((args (transient-args (oref transient-current-prefix command))) + (scope (oref transient-current-prefix scope))) + (message "prefix's scope: %s \ntransient-args: %s\n last: %s" + scope args + (length + (cl-member-if + (lambda (x) + (equal (car x) 'one)) + args))))) + +;; some JSON fields that are returned under the "source" field need to be +;; sent back in the format source[key], while some others are sent kust as +;; key: +(defun mastodon-transient-parse-source-key (key) + "Parse mastodon source KEY. +If KEY needs to be source[key], format like so, else just return +the inner key part." + (let* ((split (split-string key "[][]")) + (array-key (cadr split))) + (if (or (= 1 (length split)) ;; no split + (member array-key + '("quote_policy" "privacy" "sensitive" "language"))) + key + array-key))) + +(defun mastodon-transient-parse-source-keys (alist) + "Parse ALIST containing source[key] keys." + (cl-loop for a in alist + collect (cons (mastodon-transient-parse-source-key (car a)) + (cdr a)))) + +(defun mastodon-transient-get-creds () + "Fetch account data." + (mastodon-http--get-json + (mastodon-http--api "accounts/verify_credentials") + nil :silent)) + +;; fields utils: +;; to PATCH fields, we just need fields[x][name] and fields[x][value] + +(defun mastodon-transient--fields-alist (fields) + "Convert fields in FIELDS to numbered conses. +The keys in the data are not numbered, so we convert the key into +the format fields.X.keyname." + (cl-loop + for f in fields + for count from 1 to 5 + collect + (cl-loop for x in f + collect + (cons (concat "fields." (number-to-string count) + "." (symbol-name (car x))) + (cdr x))))) + +(defun mastodon-transient-field-dot-to-array (key) + "Convert KEY from tp dot annotation to array[key] annotation." + (tp-dot-to-array (symbol-name key) nil "_attributes")) + +(defun mastodon-transient-dot-fields-to-arrays (alist) + "Parse fields ALIST in dot notation to array notation." + (cl-loop for y in alist + collect + (cons (mastodon-transient-field-dot-to-array (car y)) + (cdr y)))) + +;;; TRANSIENTS + +;; FIXME: PATCHing source vals as JSON request body doesn't work! existing +;; `mastodon-profile--update-preference' doesn't use it! it just uses +;; query params! strange thing is it works for non-source params +(transient-define-suffix mastodon-user-settings-update (&optional args) + "Update current user settings on the server." + :transient 'transient--do-exit + (interactive (list (transient-args 'mastodon-user-settings))) + (let* ((parsed (tp-parse-args-for-send args :strings)) + (strs (mastodon-transient-parse-source-keys parsed)) + (url (mastodon-http--api "accounts/update_credentials")) + (resp (mastodon-http--patch url strs))) ;; :json fails + (mastodon-http--triage + resp + (lambda (_resp) + (message "Settings updated!\n%s" (pp-to-string strs)))))) + +(transient-define-prefix mastodon-user-settings () + "A transient for setting current user settings." + :value (lambda () (tp-return-data + #'mastodon-transient-get-creds)) + [:description + (lambda () + (format "User settings for %s" mastodon-active-user)) + (:info + "Note: use the empty string (\"\") to remove a value from an option.")] + ;; strings + ["Account info" + ("n" "display name" "display_name" :alist-key display_name :class tp-option-str) + ("t" "update profile note" mastodon-update-profile-note) + ("f" "update profile fields" mastodon-profile-fields)] + ;; "choice" booleans (so we can PATCH :json-false explicitly): + ["Account options" + ("l" "locked" "locked" :alist-key locked :class tp-bool) + ("b" "bot" "bot" :alist-key bot :class tp-bool) + ("d" "discoverable" "discoverable" :alist-key discoverable :class tp-bool) + ("c" "hide follower/following lists" "source.hide_collections" + :alist-key source.hide_collections :class tp-bool) + ("i" "indexable" "source.indexable" :alist-key source.indexable :class tp-bool)] + ["Tooting options" + ("p" "default privacy" "source.privacy" :alist-key source.privacy + :class tp-option + :choices (lambda () mastodon-toot-visibility-settings-list)) + ("s" "mark sensitive" "source.sensitive" :alist-key source.sensitive :class tp-bool) + ("g" "default language" "source.language" :alist-key source.language :class tp-option + :choices (lambda () mastodon-iso-639-regional)) + ("q" "quote policy" "source.quote_policy" :alist-key source.quote_policy + :class tp-option + :choices (lambda () mastodon-profiles-quote-policy-types))] + ["Update" + ("C-c C-c" "Save settings" mastodon-user-settings-update) + ("C-x C-k" :info "Revert all changes")] + (interactive) + (if (or (not (boundp 'mastodon-active-user)) + (not mastodon-active-user)) + (user-error "User not set") + (transient-setup 'mastodon-user-settings))) + +(transient-define-suffix mastodon-update-profile-note () + "Update current user profile note." + :transient 'transient--do-exit + (interactive) + (mastodon-profile-update-user-profile-note)) + +(transient-define-suffix mastodon-profile-fields-update (args) + "Update current user profile fields." + :transient 'transient--do-return + (interactive (list (transient-args 'mastodon-profile-fields))) + (let* (;; FIXME: maybe only changed also won't work with fields, as + ;; perhaps what is PATCHed overwrites whatever is on the server? + ;; (only-changed (tp-only-changed-args alist)) + (arrays (mastodon-transient-dot-fields-to-arrays args)) + (endpoint "accounts/update_credentials") + (url (mastodon-http--api endpoint)) + (resp (mastodon-http--patch url arrays))) ; :json))) + (mastodon-http--triage + resp (lambda (_resp) (message "Fields updated!"))))) + +(defun mastodon-transient-fetch-fields () + "Fetch profile fields (metadata)." + (tp-return-data #'mastodon-transient-get-creds nil 'fields) + (setq tp-transient-settings + (mastodon-transient--fields-alist tp-transient-settings))) + +(transient-define-prefix mastodon-profile-fields () + "A transient for setting profile fields." + :value (lambda () (mastodon-transient-fetch-fields)) + [:description + "Fields" + ["Name" + ("1 n" "" "fields.1.name" :alist-key fields.1.name :class mastodon-transient-field) + ("2 n" "" "fields.2.name" :alist-key fields.2.name :class mastodon-transient-field) + ("3 n" "" "fields.3.name" :alist-key fields.3.name :class mastodon-transient-field) + ("4 n" "" "fields.4.name" :alist-key fields.4.name :class mastodon-transient-field)] + ["Value" + ("1 v" "" "fields.1.value" :alist-key fields.1.value :class mastodon-transient-field) + ("2 v" "" "fields.2.value" :alist-key fields.2.value :class mastodon-transient-field) + ("3 v" "" "fields.3.value" :alist-key fields.3.value :class mastodon-transient-field) + ("4 v" "" "fields.4.value" :alist-key fields.4.value :class mastodon-transient-field)]] + ["Update" + ("C-c C-c" "Save settings" mastodon-profile-fields-update) + ("C-x C-k" :info "Revert all changes")] + (interactive) + (if (not mastodon-active-user) + (user-error "User not set") + (transient-setup 'mastodon-profile-fields))) + +(defun mastodon-transient-max-poll-opts () + "Return max poll options of user's instance." + (let ((instance (mastodon-instance-data))) + (mastodon-toot--fetch-max-poll-options instance))) + +(defun mastodon-transient-max-poll-opt-chars () + "Return max poll option characters of user's instance." + (let ((instance (mastodon-instance-data))) + (mastodon-toot--fetch-max-poll-option-chars instance))) + +(transient-define-suffix mastodon-transient-choice-add () + "Add another poll choice if possible. +Do not add more than 9 choices. +Do not add more than the server's maximum setting." + (interactive) + :transient 'transient--do-stay + (let* ((args (transient-args (oref transient-current-prefix command))) + (choice-count (length + (cl-member-if + (lambda (x) + (equal (car x) 'one)) + args))) + (inc (1+ choice-count)) + (next (number-to-string inc)) + (next-symbol (pcase inc + (5 'five) + (6 'six) + (7 'seven) + (8 'eight) + (9 'nine)))) + (if (or (>= choice-count (mastodon-transient-max-poll-opts)) + (= choice-count 9)) + ;; FIXME when we hit '10', we get a binding clash with '1'. :/ + (message "Max choices reached") + (transient-append-suffix + 'mastodon-create-poll + '(2 -1) + `(,next "" ,next + :class mastodon-transient-poll-choice + :alist-key ,next-symbol + :transient t)))) + (transient-setup 'mastodon-create-poll)) + +(transient-define-prefix mastodon-create-poll () + "A transient for creating a poll." + :value (lambda () + ;; we set `tp-transient-settings' here to the poll value poss + ;; pulled from the server by + ;; `mastodon-toot--server-poll-to-local'. when we are done with + ;; the transient, we set `mastodon-toot-poll' again + (setq tp-transient-settings mastodon-toot-poll)) + ["Create poll" + (:info (lambda () + (format "Max options: %s" + (mastodon-transient-max-poll-opts)))) + (:info (lambda () + (format "Max option length: %s" + (mastodon-transient-max-poll-opt-chars))))] + ["Options" + ("m" "Multiple choice?" "multi" :alist-key multi + :class mastodon-transient-poll-bool) + ("h" "Hide vote count till expiry?" "hide" :alist-key hide + :class mastodon-transient-poll-bool) + ("e" "Expiry" "expiry" :alist-key expiry + :class mastodon-transient-expiry)] + ["Choices" + ("1" "" "1" :alist-key one :class mastodon-transient-poll-choice) + ("2" "" "2" :alist-key two :class mastodon-transient-poll-choice) + ("3" "" "3" :alist-key three :class mastodon-transient-poll-choice) + ("4" "" "4" :alist-key four :class mastodon-transient-poll-choice)] + ;; TODO: display the max number of options or add options cmd + ["Update" + ("C-c C-s" "Add another poll choice" mastodon-transient-choice-add + :if (lambda () (< 4 (mastodon-transient-max-poll-opts)))) + ("C-c C-c" "Save and done" mastodon-create-poll-done) + ("C-x C-k" :info "Revert all") + ("C-c C-k" "Delete all" mastodon-clear-poll)] + (interactive) + (if (not mastodon-active-user) + (user-error "User not set") + (transient-setup 'mastodon-create-poll))) + +(transient-define-suffix mastodon-clear-poll () + "Clear current poll data." + :transient 'transient--do-stay + (interactive) + (mastodon-toot-clear-poll :transient) + (transient-reset)) + +(transient-define-suffix mastodon-create-poll-done (args) + "Finish setting poll details." + :transient 'transient--do-exit + (interactive (list (transient-args 'mastodon-create-poll))) + (let* ((options (cl-member-if (lambda (x) + (eq (car x) 'one)) + args)) + (opt-vals (cl-loop for x in options + collect (cdr x))) + (lengths (mapcar #'length opt-vals)) + (vals (cl-remove 'nil + (cl-loop for x in args + collect (cdr x)))) + (opts-count (length (cl-remove 'nil opt-vals)))) + ;; this way of checking gets annoying if we want to just cancel out of + ;; the poll (but to actually cancel user should C-g, not C-c C-c): + (if (or (and (< 50 (apply #'max lengths)) + (not (y-or-n-p "Options longer than server max. Proceed? "))) + (and (not (alist-get 'expiry args)) + (not (y-or-n-p "No expiry. Proceed? "))) + (and (not (< 1 opts-count)) + (not (y-or-n-p "Need more than one option. Proceed? "))) + (and (> opts-count (mastodon-transient-max-poll-opts)) + (not (y-or-n-p "More options than server max. Proceed? ")))) + (call-interactively #'mastodon-create-poll) + ;; if we are called with no poll data, do not set: + (unless (not vals) + ;; we set `mastodon-toot-poll' here not `tp-transient-settings' + ;; as that is our var outside of our transient: + (setq mastodon-toot-poll + (tp-bools-to-strs args))) + (mastodon-toot--update-status-fields)))) + +(defvar mastodon-notifications-policy-vals) +(declare-function mastodon-notifications-get-policy "mastodon-notifications") +(declare-function mastodon-notifications--update-policy "mastodon-notifications") + +(transient-define-prefix mastodon-notifications-policy () + "A transient to set notifications policy options." + ;; https://docs.joinmastodon.org/methods/notifications/#get-policy + :value (lambda () (tp-return-data #'mastodon-notifications-get-policy)) + ["Notification policy options" + ("f" "people you don't follow" "for_not_following" + :alist-key for_not_following :class mastodon-transient-policy) + ("F" "people not following you" "for_not_followers" + :alist-key for_not_followers :class mastodon-transient-policy) + ("n" "New accounts" "for_new_accounts" + :alist-key for_new_accounts :class mastodon-transient-policy) + ("p" "Unsolicited private mentions" "for_private_mentions" + :alist-key for_private_mentions :class mastodon-transient-policy) + ("l" "Moderated accounts" "for_limited_accounts" + :alist-key for_limited_accounts :class mastodon-transient-policy) + (:info "") + (:info "\"accept\" = receive notifications") + (:info "\"filter\" = mark as filtered") + (:info "\"drop\" = do not receive any notifications")] + ["Notification requests" + (:info #'mastodon-notifications-requests-count) + (:info #'mastodon-notifications-filtered-count)] + ["Update" + ("C-c C-c" "Save settings" mastodon-notifications-policy-update) + ("C-x C-k" :info "Revert all changes")]) + +(defun mastodon-notifications-requests-count () + "Format a string for pending requests." + (let ((val ;; (oref transient--prefix value))) ;; deprecated + ;; (transient-get-value)) ;; broken + tp-transient-settings)) ;; dubious + (format "Pending requests: %d" + (or (map-nested-elt + val + '(summary pending_requests_count)) + 0)))) + +(defun mastodon-notifications-filtered-count () + "Format a string for pending notifications." + (let ((val ;; (oref transient--prefix value))) ;; deprecated + ;; (transient-get-value)) ;; broken + tp-transient-settings)) ;; dubious + (format "Pending notifications: %d" + (or (map-nested-elt + val + '(summary pending_notifications_count)) + 0)))) + +(transient-define-suffix mastodon-notifications-policy-update (args) + "Send updated notification policy settings." + :transient 'transient--do-exit + ;; TODO: + (interactive (list (transient-args 'mastodon-notifications-policy))) + (let* ((parsed (tp-parse-args-for-send args)) + (resp (mastodon-notifications--update-policy parsed))) + (mastodon-http--triage + resp + (lambda (_resp) + (message "Settings updated!\n%s" (pp-to-string parsed)))))) + +;;; CLASSES + +(defclass mastodon-transient-policy (tp-cycle) + ((choices :initarg :choices :initform 'mastodon-notifications-policy-vals)) + "An option class for mastodon notification policy options.") + +(defclass mastodon-transient-field (tp-option-str) + ((always-read :initarg :always-read :initform t)) + "An infix option class for our options. +We always read.") + +(cl-defmethod transient-init-value ((obj mastodon-transient-field)) + "Initialize value of OBJ." + (let* ((prefix-val ;; (oref transient--prefix value))) ;; deprecated + ;; (transient-get-value)) ;; broken + tp-transient-settings)) ;; dubious + ;; (arg (oref obj alist-key))) + (oset obj value + (tp-get-server-val obj prefix-val)))) + +(cl-defmethod tp-get-server-val ((obj mastodon-transient-field) data) + "Return the server value for OBJ from DATA. +If OBJ's key has dotted notation, drill down into the alist. Currently +only one level of nesting is supported." + ;; TODO: handle nested alist keys + (let* ((key (oref obj alist-key)) + (split (split-string (symbol-name key) "\\.")) + (num (string-to-number (cadr split)))) + (alist-get key + (nth (1- num) data) nil nil #'string=))) + +(cl-defmethod tp-arg-changed-p ((_obj mastodon-transient-field) cons) + "T if value of OBJ is changed from the server value. +CONS is a cons of the form \"(fields.1.name . val)\"." + (let* ((key-split (split-string + (symbol-name (car cons)) "\\.")) + (num (1- (string-to-number (nth 1 key-split)))) + (server-key (symbol-name (car cons))) + (server-elt (nth num tp-transient-settings))) + (not (equal (cdr cons) + (alist-get server-key server-elt nil nil #'string=))))) + +(defclass mastodon-transient-opt (tp-option tp-option-var) + (())) + +(defclass mastodon-transient-poll-bool (tp-bool tp-option-var) + ()) + +(defclass mastodon-transient-poll-choice (tp-option-str tp-option-var) + ()) + +(cl-defmethod transient-infix-read ((obj mastodon-transient-poll-choice)) + "Reader function for OBJ, a poll expiry." + (let* ((value (transient-infix-value obj)) + (prompt (transient-prompt obj)) + (str (read-string prompt (cdr value))) + (max (mastodon-transient-max-poll-opt-chars))) + (if (not (> (length str) max)) + str + (if (not + (y-or-n-p + (format "Poll option too long for server (%s/%s chars), retry?" + (length str) max))) + str + (oset obj value str) + (transient-infix-read obj))))) + +(defclass mastodon-transient-expiry (tp-option tp-option-var) + ()) + +(cl-defmethod transient-infix-read ((_obj mastodon-transient-expiry)) + "Reader function for OBJ, a poll expiry." + (cdr (mastodon-toot--read-poll-expiry))) + +(cl-defmethod transient-format-value ((obj mastodon-transient-expiry)) + "Format function for OBJ, a poll expiry." + (let* ((cons (transient-infix-value obj)) + (value (when cons (cdr cons)))) + (if (not value) + "" + (let ((readable + (or (car + (rassoc value + (mastodon-toot--poll-expiry-options-alist))) + (concat value " secs")))) ;; editing a poll wont match expiry list + (propertize readable + 'face (if (tp-arg-changed-p obj cons) + 'transient-value + 'transient-inactive-value)))))) + +(provide 'mastodon-transient) +;;; mastodon-transient.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-views.el b/elpa/mastodon-20260406.856/mastodon-views.el new file mode 100644 index 00000000..53d5a4db --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-views.el @@ -0,0 +1,1074 @@ +;;; mastodon-views.el --- Minor views functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2024 Marty Hiatt +;; Author: Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; 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") + + +;;; 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.") + + +;;; GENERAL FUNCTION + +(defun mastodon-views--minor-view (view-name insert-fun data) + "Load a minor view named VIEW-NAME. +BINDINGS-STRING is a string explaining the view's local bindings. +INSERT-FUN is the function to call to insert the view's elements. +DATA is the argument to insert-fun, usually JSON returned in a +request. +This function is used as the update-function to +`mastodon-tl--init-sync', which initializes a buffer for us and +provides the JSON data." + ;; FIXME not tecnically an update-fun for init-sync, but just a simple way + ;; to set up the empty buffer or else call the insert-fun. not sure if we cd + ;; improve by eg calling init-sync in here, making this a real view function. + (if (seq-empty-p data) + (insert (propertize + (format "Looks like you have no %s for now." view-name) + 'face 'mastodon-toot-docs-face + 'byline t + 'item-type 'no-item ; for nav + 'item-id "0")) ; so point can move here when no item + (funcall insert-fun data) + (goto-char (point-min))) + ;; (when data + ;; FIXME: this seems to trigger a new request, but ideally would run. + ;; (mastodon-tl-goto-next-item)) + ) + + +;;; LISTS + +(defun mastodon-views-view-lists () + "Show the user's lists in a new buffer." + (interactive) + (mastodon-tl--init-sync "lists" "lists" + 'mastodon-views--insert-lists + nil nil nil + "your lists" + "C - create a list\n D - delete a list\ + \n A/R - add/remove account from a list\ + \n E - edit a list\n n/p - go to next/prev item") + (with-current-buffer "*mastodon-lists*" + (use-local-map mastodon-views--view-lists-keymap))) + +(defun mastodon-views--insert-lists (json) + "Insert the user's lists from JSON." + (mastodon-views--minor-view + "lists" + #'mastodon-views--print-list-set + json)) + +(defun mastodon-views--print-list-set (lists) + "Print each account plus a separator for each list in LISTS." + (cl-loop for x in lists + do (progn + (mastodon-views--print-list-accounts x) + (insert (propertize (concat " " mastodon-tl--horiz-bar "\n\n") + 'face 'success))))) + +(defun mastodon-views--print-list-accounts (list) + "Insert the accounts in list named LIST, an alist." + (let-alist list + (let* ((accounts (mastodon-views--accounts-in-list .id))) + (insert + (propertize .title + 'byline t ; so we nav here + 'item-id "0" ; so we nav here + 'item-type 'list + 'help-echo "RET: view list timeline, d: delete this list, \ +a: add account to this list, r: remove account from this list" + 'list t + 'face 'link + 'keymap mastodon-views--list-name-keymap + 'list-name .title + 'list-id .id) + (propertize (format " [replies: %s, exclusive %s]" + .replies_policy + (when (eq t .exclusive) "true")) + 'face 'mastodon-toot-docs-face) + (propertize "\n\n" + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name .title + 'list-id .id) + (propertize + (mapconcat #'mastodon-search--propertize-user accounts + " ") + 'list t + 'keymap mastodon-views--list-name-keymap + 'list-name .title + 'list-id .id))))) + +(defun mastodon-views--get-users-lists () + "Get the list of the user's lists from the server." + (let ((url (mastodon-http--api "lists"))) + (mastodon-http--get-json url))) + +(defun mastodon-views--get-lists-names () + "Return a list of the user's lists' names." + (let ((lists (mastodon-views--get-users-lists))) + (mastodon-tl--map-alist 'title lists))) + +(defun mastodon-views--get-list-by-name (name) + "Return the list data for list with NAME." + (let* ((lists (mastodon-views--get-users-lists))) + (cl-loop for list in lists + if (string= (alist-get 'title list) name) + return list))) + +(defun mastodon-views--get-list-id (name) + "Return id for list with NAME." + (let ((list (mastodon-views--get-list-by-name name))) + (alist-get 'id list))) + +(defun mastodon-views--get-list-name (id) + "Return name of list with ID." + (let* ((url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--get-json url))) + (alist-get 'title response))) + +(defun mastodon-views-edit-list-at-point () + "Edit list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views-edit-list id))) + +(defun mastodon-views-edit-list (&optional id) + "Prompt for a list and edit the name and replies policy. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (name-old (if id + (mastodon-tl--property 'list-name :no-move) + (completing-read "Edit list: " list-names))) + (id (or id (mastodon-views--get-list-id name-old))) + (name-choice (read-string "List name: " name-old)) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) + (exclusive (if (y-or-n-p "Exclude items from home timeline? ") + "true" + "false")) + (url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--put url + `(("title" . ,name-choice) + ("replies_policy" . ,replies-policy) + ("exclusive" . ,exclusive))))) + (mastodon-http--triage response + (lambda (_) + (with-current-buffer response + (let* ((json (mastodon-http--process-json)) + (name-new (alist-get 'title json))) + (message "list %s edited to %s!" name-old name-new))) + (when (mastodon-tl--buffer-type-eq 'lists) + (mastodon-views-view-lists)))))) + +(defun mastodon-views-view-timeline-list-at-point () + "View timeline of list at point." + (interactive) + (let ((list-id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views-view-list-timeline list-id))) + +(defun mastodon-views-view-list-timeline (&optional id) + "Prompt for a list and view its timeline. +If ID is provided, use that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (list-name (unless id (completing-read "View list: " list-names))) + (id (or id (mastodon-views--get-list-id list-name))) + (endpoint (format "timelines/list/%s" id)) + (name (mastodon-views--get-list-name id)) + (buffer-name (format "list-%s" name))) + (mastodon-tl--init buffer-name endpoint + 'mastodon-tl--timeline nil + `(("limit" . ,mastodon-tl--timeline-posts-count))))) + +(defun mastodon-views-create-list () + "Create a new list. +Prompt for name and replies policy." + (interactive) + (let* ((title (read-string "New list name: ")) + (replies-policy + (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) ; default + (exclusive (when (y-or-n-p "Exclude items from home timeline? ") + "true")) + (response (mastodon-http--post + (mastodon-http--api "lists") + `(("title" . ,title) + ("replies_policy" . ,replies-policy) + ("exclusive" . ,exclusive))))) + (mastodon-views--list-action-triage + response "list %s created!" title))) + +(defun mastodon-views-delete-list-at-point () + "Delete list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views-delete-list id))) + +(defun mastodon-views-delete-list (&optional id) + "Prompt for a list and delete it. +If ID is provided, delete that list." + (interactive) + (let* ((list-names (unless id (mastodon-views--get-lists-names))) + (name (if id + (mastodon-views--get-list-name id) + (completing-read "Delete list: " list-names))) + (id (or id (mastodon-views--get-list-id name))) + (url (mastodon-http--api (format "lists/%s" id)))) + (when (y-or-n-p (format "Delete list %s?" name)) + (let ((response (mastodon-http--delete url))) + (mastodon-views--list-action-triage + response "list %s deleted!" name))))) + +(defun mastodon-views--get-users-followings () + "Return the list of followers of the logged in account." + (let* ((id (mastodon-auth--get-account-id)) + (url (mastodon-http--api (format "accounts/%s/following" id)))) + (mastodon-http--get-json url '(("limit" . "80"))))) ; max 80 accounts + +(defun mastodon-views-add-account-to-list-at-point () + "Prompt for account and add to list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views-add-account-to-list id))) + +(defun mastodon-views-add-account-to-list (&optional id account-id handle) + "Prompt for a list and for an account, add account to list. +If ID is provided, use that list. +If ACCOUNT-ID and HANDLE are provided use them rather than prompting." + (interactive) + (let* ((list-prompt (if handle + (format "Add %s to list: " handle) + "Add account to list: ")) + (list-name (if id + (mastodon-tl--property 'list-name :no-move) + (completing-read list-prompt + (mastodon-views--get-lists-names) nil t))) + (list-id (or id (mastodon-views--get-list-id list-name))) + (followings (unless handle + (mastodon-views--get-users-followings))) + (handles (unless handle + (mastodon-tl--map-alist-vals-to-alist + 'acct 'id followings))) + (account (or handle (completing-read "Account to add: " + handles nil t))) + (account-id (or account-id (alist-get account handles))) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (response (mastodon-http--post url `(("account_ids[]" . ,account-id))))) + (mastodon-views--list-action-triage + response "%s added to list %s!" account list-name))) + +(defun mastodon-views-add-toot-account-at-point-to-list () + "Prompt for a list, and add the account of the toot at point to it." + (interactive) + (let* ((toot (mastodon-tl--property 'item-json)) + (account (mastodon-tl--field 'account toot)) + (account-id (mastodon-tl--field 'id account)) + (handle (mastodon-tl--field 'acct account))) + (mastodon-views-add-account-to-list nil account-id handle))) + +(defun mastodon-views-remove-account-from-list-at-point () + "Prompt for account and remove from list at point." + (interactive) + (let ((id (mastodon-tl--property 'list-id :no-move))) + (mastodon-views-remove-account-from-list id))) + +(defun mastodon-views-remove-account-from-list (&optional id) + "Prompt for a list, select an account and remove from list. +If ID is provided, use that list." + (interactive) + (let* ((list-name (if id + (mastodon-tl--property 'list-name :no-move) + (completing-read "Remove account from list: " + (mastodon-views--get-lists-names) nil t))) + (list-id (or id (mastodon-views--get-list-id list-name))) + (accounts (mastodon-views--accounts-in-list list-id)) + (handles (mastodon-tl--map-alist-vals-to-alist 'acct 'id accounts)) + (account (completing-read "Account to remove: " handles nil t)) + (account-id (alist-get account handles)) + (url (mastodon-http--api (format "lists/%s/accounts" list-id))) + (args (mastodon-http--build-array-params-alist "account_ids[]" `(,account-id))) + (response (mastodon-http--delete url args))) + (mastodon-views--list-action-triage + response "%s removed from list %s!" account list-name))) + +(defun mastodon-views--list-action-triage (response &rest args) + "Call `mastodon-http--triage' on RESPONSE and call message on ARGS." + (mastodon-http--triage response + (lambda (_) + (when (mastodon-tl--buffer-type-eq 'lists) + (mastodon-views-view-lists)) + (apply #'message args)))) + +(defun mastodon-views--accounts-in-list (list-id) + "Return the JSON of the accounts in list with LIST-ID." + (let* ((url (mastodon-http--api (format "lists/%s/accounts" list-id)))) + (mastodon-http--get-json url))) + + +;;; 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))) + + +;;; SCHEDULED TOOTS + +;;;###autoload +(defun mastodon-views-view-scheduled-toots () + "Show the user's scheduled toots in a new buffer." + (interactive) + (mastodon-tl--init-sync "scheduled-toots" + "scheduled_statuses" + 'mastodon-views--insert-scheduled-toots + nil nil nil + "your scheduled toots" + "n/p - prev/next\n r - reschedule\n\ + e/RET - edit toot\n c - cancel") + (with-current-buffer "*mastodon-scheduled-toots*" + (use-local-map mastodon-views--scheduled-map))) + +(defun mastodon-views--insert-scheduled-toots (json) + "Insert the user's scheduled toots, from JSON." + (mastodon-views--minor-view + "scheduled toots" + #'mastodon-views--insert-scheduled-toots-list + json)) + +(defun mastodon-views--insert-scheduled-toots-list (scheduleds) + "Insert scheduled toots in SCHEDULEDS." + (mapc #'mastodon-views--insert-scheduled-toot scheduleds)) + +(defun mastodon-views--insert-scheduled-toot (toot) + "Insert scheduled TOOT into the buffer." + (let-alist toot + (insert + (propertize (concat (string-trim .params.text) + " | " + (mastodon-toot--iso-to-human .scheduled_at)) + 'byline t ; so we nav here + 'item-type 'scheduled ; so we nav here + 'face 'mastodon-toot-docs-face + 'keymap mastodon-views--scheduled-map + 'item-json toot + 'id .id) + "\n"))) + +(defun mastodon-views--get-scheduled-toots (&optional id) + "Get the user's currently scheduled toots. +If ID, just return that toot." + (let* ((endpoint (if id + (format "scheduled_statuses/%s" id) + "scheduled_statuses")) + (url (mastodon-http--api endpoint))) + (mastodon-http--get-json url))) + +(defun mastodon-views-reschedule-toot () + "Reschedule the scheduled toot at point." + (interactive) + (mastodon-tl--do-if-item + (mastodon-toot-schedule-toot :reschedule))) + +(defun mastodon-views-copy-scheduled-toot-text () + "Copy the text of the scheduled toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot :no-move)) + (params (alist-get 'params toot)) + (text (alist-get 'text params))) + (kill-new text))) + +(defun mastodon-views-cancel-scheduled-toot (&optional id no-confirm) + "Cancel the scheduled toot at point. +ID is that of the scheduled toot to cancel. +NO-CONFIRM means there is no ask or message, there is only do." + (interactive) + (mastodon-tl--do-if-item + (when (or no-confirm + (y-or-n-p "Cancel scheduled toot?")) + (let* ((id (or id (mastodon-tl--property 'id :no-move))) + (url (mastodon-http--api (format "scheduled_statuses/%s" id))) + (response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda (_) + (mastodon-views-view-scheduled-toots) + (unless no-confirm + (message "Toot cancelled!")))))))) + +(defun mastodon-views-edit-scheduled-as-new () + "Edit scheduled status as new toot." + (interactive) + (mastodon-tl--do-if-item + (let* ((toot (mastodon-tl--property 'scheduled-json :no-move)) + (id (mastodon-tl--property 'id :no-move)) + (scheduled (alist-get 'scheduled_at toot))) + (let-alist (alist-get 'params toot) + ;; TODO: preserve polls + ;; (poll (alist-get 'poll params)) + (mastodon-toot--compose-buffer nil .in_reply_to_id nil .text :edit) + (goto-char (point-max)) + ;; adopt properties from scheduled toot: + (mastodon-toot--set-toot-properties + .in_reply_to_id .visibility .spoiler_text .language + scheduled id (alist-get 'media_attachments toot)))))) + + +;;; FILTERS + +;;;###autoload +(defun mastodon-views-view-filters () + "View the user's filters in a new buffer." + (interactive) + (mastodon-tl--init-sync "filters" "filters" + 'mastodon-views--insert-filters + nil nil nil + "current filters" + "c/u - create/update filter | d/k - delete filter\ + at point\n a/r/U - add/remove/Update filter keyword\n\ + n/p - next/prev filter" "v2") + (with-current-buffer "*mastodon-filters*" + (use-local-map mastodon-views--view-filters-keymap))) + +(defun mastodon-views--insert-filters (json) + "Insert a filter string plus a blank line. +JSON is the filters data." + (mapc #'mastodon-views--insert-filter json)) + +(require 'table) + +(defun mastodon-views--insert-filter-kws (kws) + "Insert filter keywords KWS." + (insert "\n") + (let ((beg (point)) + (table-cell-horizontal-chars (if (char-displayable-p ?–) + "–" + "-")) + (whole-str "whole words only:")) + (insert (concat "Keywords: | " whole-str "\n")) + (cl-loop for kw in kws + do (let ((whole (if (eq :json-false (alist-get 'whole_word kw)) + "nil" + "t"))) + (insert + (propertize (concat + (format "\"%s\" | %s\n" + (alist-get 'keyword kw) whole)) + 'kw-id (alist-get 'id kw) + 'item-json kw + 'mastodon-tab-stop t + 'whole-word whole)))) + ;; table display of kws: + (table-capture beg (point) "|" "\n" nil (+ 2 (length whole-str))) + (table-justify-column 'center) + (table-forward-cell) ;; col 2 + (table-justify-column 'center) + (mastodon-views--end-of-table))) + +(defun mastodon-views--end-of-table () + "" + (while (re-search-forward ;; goto end of table: + (concat table-cell-horizontal-chars + (make-string 1 table-cell-intersection-char) + "\n") + nil :no-error))) + +(defun mastodon-views--insert-filter (filter) + "Insert a single FILTER." + (let-alist filter + (insert + ;; FIXME: awful hack to fix nav: exclude horiz-bar from propertize then + ;; propertize rest of the filter text. if we add only byline prop to + ;; title, point will move to end of title, because at that byline-prop + ;; change, item-type prop is present. + (mastodon-tl--set-face + (concat "\n " mastodon-tl--horiz-bar "\n ") + 'success) + (propertize + (concat + ;; heading: + (mastodon-tl--set-face + (concat (upcase .title) " " "\n " + mastodon-tl--horiz-bar "\n") + 'success) + ;; context: + (concat "Context: " (mapconcat #'identity .context ", ")) + ;; type (warn or hide): + (concat "\nType: " .filter_action)) + 'item-json filter + 'byline t + 'item-id .id + 'filter-title .title + 'item-type 'filter)) + ;; terms list: + (when .keywords ;; poss to have no keywords + (mastodon-views--insert-filter-kws .keywords)))) + +(defvar mastodon-views--filter-types + '("home" "notifications" "public" "thread" "profile")) + +(defun mastodon-views-create-filter (&optional id title context type terms) + "Create a filter for a word. +Prompt for a context, must be a list containting at least one of \"home\", +\"notifications\", \"public\", \"thread\". +Optionally, provide ID, TITLE, CONTEXT, TYPE, and TERMS to update a filter." + (interactive) + ;; ID non-nil = we are updating + (let* ((url (mastodon-http--api-v2 + (if id (format "filters/%s" id) "filters"))) + (title (or title (read-string "Filter name: "))) + (terms (or terms + (read-string "Terms to filter (comma or space separated): "))) + (terms-split (split-string terms "[, ]")) + (terms-processed + (if (not terms) ;; well actually it is poss to have no terms + (user-error "You must select at least one term") + (mastodon-http--build-array-params-alist + "keywords_attributes[][keyword]" terms-split))) + (warn-or-hide + (or type (completing-read "Warn (like CW) or hide? " + '("warn" "hide") nil :match))) + ;; TODO: display "home (and lists)" but just use "home" for API + (contexts + (or context (completing-read-multiple + "Filter contexts [TAB for options, comma separated]: " + mastodon-views--filter-types nil :match))) + (contexts-processed + (if (not contexts) + (user-error "You must select at least one context") + (mastodon-http--build-array-params-alist "context[]" contexts))) + (params (append `(("title" . ,title) + ("filter_action" . ,warn-or-hide)) + terms-processed + contexts-processed)) + (resp (if id + (mastodon-http--put url params) + (mastodon-http--post url params)))) + (mastodon-views--filters-triage + resp + (message "Filter %s %s!" title (if id "updated" "created"))))) + +(defun mastodon-views-update-filter () + "Update filter at point." + (interactive) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((filter (mastodon-tl--property 'item-json)) + (id (mastodon-tl--property 'item-id)) + (name (read-string "Name: " (alist-get 'title filter))) + (contexts (completing-read-multiple + "Filter contexts [TAB for options, comma separated]: " + mastodon-views--filter-types nil :match + (mapconcat #'identity + (alist-get 'context filter) ","))) + (type (completing-read "Warn (like CW) or hide? " + '("warn" "hide") nil :match + (alist-get 'type filter))) + (terms (read-string "Terms to add (comma or space separated): "))) + (mastodon-views-create-filter id name contexts type terms)))) + +(defun mastodon-views-delete-filter () + "Delete filter at point." + (interactive) + (let* ((id (mastodon-tl--property 'item-id :no-move)) + (title (mastodon-tl--property 'filter-title :no-move)) + (url (mastodon-http--api-v2 (format "filters/%s" id)))) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (when (y-or-n-p (format "Delete filter %s? " title)) + (let ((resp (mastodon-http--delete url))) + (mastodon-views--filters-triage + resp + (message "Filter \"%s\" deleted!" title))))))) + +(defun mastodon-views--get-filter-kw (&optional id) + "GET filter with ID." + (let* ((id (or id (mastodon-tl--property 'kw-id :no-move))) + (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) + (resp (mastodon-http--get-json url))) + resp)) + +(defun mastodon-views-update-filter-kw () + "Update filter keyword. +Prmopt to change the term, and the whole words option. +When t, whole words means only match whole words." + (interactive) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((kws (alist-get 'keywords + (mastodon-tl--property 'item-json :no-move))) + (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws)) + (choice (completing-read "Update keyword: " alist)) + (updated (read-string "Keyword: " choice)) + (whole-word (if (y-or-n-p "Match whole words only? ") + "true" + "false")) + (params `(("keyword" . ,updated) + ("whole_word" . ,whole-word))) + (id (cdr (assoc choice alist #'string=))) + (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) + (resp (mastodon-http--put url params))) + (mastodon-views--filters-triage resp + (format "Keyword %s updated!" updated))))) + +(defun mastodon-views--filters-triage (resp msg-str) + "Triage filter action response RESP, reload filters, message MSG-STR." + (mastodon-http--triage + resp + (lambda (_resp) + (when (mastodon-tl--buffer-type-eq 'filters) + (mastodon-views-view-filters)) + (message msg-str)))) + +(defun mastodon-views-add-filter-kw () + "Add a keyword to filter at point." + (interactive) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((kw (read-string "Keyword: ")) + (id (mastodon-tl--property 'item-id :no-move)) + (whole-word (if (y-or-n-p "Match whole words only? ") + "true" + "false")) + (params `(("keyword" . ,kw) + ("whole_word" . ,whole-word))) + (url (mastodon-http--api-v2 (format "filters/%s/keywords" id))) + (resp (mastodon-http--post url params))) + (mastodon-views--filters-triage resp + (format "Keyword %s added!" kw))))) + +(defun mastodon-views-remove-filter-kw () + "Remove keyword from filter at point." + (interactive) + (if (not (eq 'filter (mastodon-tl--property 'item-type))) + (user-error "No filter at point?") + (let* ((kws (alist-get 'keywords + (mastodon-tl--property 'item-json :no-move))) + (alist (mastodon-tl--map-alist-vals-to-alist 'keyword 'id kws)) + (choice (completing-read "Remove keyword: " alist)) + (id (cdr (assoc choice alist #'string=))) + (url (mastodon-http--api-v2 (format "filters/keywords/%s" id))) + (resp (mastodon-http--delete url))) + (mastodon-views--filters-triage resp (format "Keyword %s removed!" choice))))) + + +;;; 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)) + + +;;; INSTANCES + +(defun mastodon-views-view-own-instance (&optional brief) + "View details of your own instance. +BRIEF means show fewer details." + (interactive) + (mastodon-views-view-instance-description :user brief)) + +(defun mastodon-views-view-own-instance-brief () + "View brief details of your own instance." + (interactive) + (mastodon-views-view-instance-description :user :brief)) + +(defun mastodon-views-view-instance-description-brief () + "View brief details of the instance the current post's author is on." + (interactive) + (mastodon-views-view-instance-description nil :brief)) + +(defun mastodon-views--get-instance-url (url username &optional instance) + "Return an instance base url from a user account URL. +USERNAME is the name to cull. +If INSTANCE is given, use that." + (cond (instance (concat "https://" instance)) + ;; pleroma URL is https://instance.com/users/username + ((string-suffix-p "users/" (url-basepath url)) + (string-remove-suffix "/users/" + (url-basepath url))) + ;; friendica is https://instance.com/profile/user + ((string-suffix-p "profile/" (url-basepath url)) + (string-remove-suffix "/profile/" + (url-basepath url))) + ;; snac is https://instance.com/user + ((not (string-match-p "@" url)) + ;; cull trailing slash: + (string-trim-right (url-basepath url) "/")) + ;; mastodon is https://instance.com/@user + (t + (string-remove-suffix (concat "/@" username) + url)))) + +(defun mastodon-views--get-own-instance () + "Return JSON of `mastodon-active-user's instance." + (mastodon-http--get-json + (mastodon-http--api "instance" "v2") nil nil :vector)) + +(defun mastodon-views-view-instance-description + (&optional user brief instance misskey) + "View the details of the instance the current post's author is on. +USER means to show the instance details for the logged in user. +BRIEF means to show fewer details. +INSTANCE is an instance domain name. +MISSKEY means the instance is a Misskey or derived server." + (interactive) + (if user + (let ((response (mastodon-views--get-own-instance))) + (mastodon-views--instance-response-fun response brief instance)) + (mastodon-tl--do-if-item + (let* ((toot (or (and (mastodon-tl--profile-buffer-p) + (mastodon-tl--property 'profile-json)) ; either profile + (mastodon-tl--property 'item-json))) ; or toot or user listing + (reblog (alist-get 'reblog toot)) + (account (or (alist-get 'account reblog) + (alist-get 'account toot) + toot)) ; else `toot' is already an account listing. + ;; we may be at toots/boosts/users in a profile buffer. + ;; profile-json is a defacto test for if point is on the profile + ;; details at the top of a profile buffer. + (profile-note-p (and (mastodon-tl--profile-buffer-p) + ;; only call this in profile buffers: + (mastodon-tl--property 'profile-json))) + (url (if profile-note-p + (alist-get 'url toot) ; profile description + (alist-get 'url account))) + (username (if profile-note-p + (alist-get 'username toot) ;; profile + (alist-get 'username account))) + (instance (mastodon-views--get-instance-url url username instance))) + (if misskey + (let* ((params `(("detail" . ,(or brief t)))) + (headers '(("Content-Type" . "application/json"))) + (url (concat instance "/api/meta")) + (response + (with-current-buffer (mastodon-http--post url params headers t :json) + (mastodon-http--process-response)))) + (mastodon-views--instance-response-fun response brief instance :misskey)) + (let ((response (mastodon-http--get-json + (concat instance "/api/v1/instance") nil nil :vector))) + ;; if non-misskey attempt errors, try misskey instance: + ;; akkoma i guess should not error here. + (if (eq 'error (caar response)) + (mastodon-views-instance-desc-misskey) + (mastodon-views--instance-response-fun response brief instance)))))))) + +(defun mastodon-views-instance-desc-misskey (&optional user brief instance) + "Show instance description for a misskey/firefish server. +USER, BRIEF, and INSTANCE are all for +`mastodon-views-view-instance-description', which see." + (interactive) + (mastodon-views-view-instance-description user brief instance :miskey)) + +(defun mastodon-views--instance-response-fun (response brief instance + &optional misskey) + "Display instance description RESPONSE in a new buffer. +BRIEF means to show fewer details. +INSTANCE is the instance were are working with. +MISSKEY means the instance is a Misskey or derived server." + (when response + (let* ((domain (url-file-nondirectory instance)) + (buf (get-buffer-create + (format "*mastodon-instance-%s*" domain)))) + (with-mastodon-buffer buf #'special-mode :other-window + (if misskey + (mastodon-views--insert-json response) + (condition-case nil + (progn + (when brief + (setq response + (list (assoc 'uri response) + (assoc 'title response) + (assoc 'short_description response) + (assoc 'email response) + (cons 'contact_account + (list + (assoc 'username + (assoc 'contact_account response)))) + (assoc 'rules response) + (assoc 'stats response)))) + (mastodon-views--print-json-keys response) + (mastodon-tl--set-buffer-spec (buffer-name buf) "instance" nil) + (goto-char (point-min))) + (error ; just insert the raw response: + (mastodon-views--insert-json response)))))))) + +(defun mastodon-views--insert-json (response) + "Insert raw JSON RESPONSE in current buffer." + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (prin1-to-string response)) + (pp-buffer) + (goto-char (point-min)))) + +(defun mastodon-views--format-key (el pad) + "Format a key of element EL, a cons, with PAD padding." + (format (concat "%-" + (number-to-string pad) + "s: ") + (propertize (prin1-to-string (car el)) + 'face '(:underline t)))) + +(defun mastodon-views--print-json-keys (response &optional ind) + "Print the JSON keys and values in RESPONSE. +IND is the optional indentation level to print at." + (let* ((cars (mapcar (lambda (x) (symbol-name (car x))) + response)) + (pad (1+ (apply #'max (mapcar #'length cars))))) + (while response + (let ((el (pop response))) + (cond + ((and (vectorp (cdr el)) ; vector of alists (fields, instance rules): + (not (seq-empty-p (cdr el))) + (consp (seq-elt (cdr el) 0))) + (insert (mastodon-views--format-key el pad) + "\n\n") + (seq-do #'mastodon-views--print-instance-rules-or-fields (cdr el)) + (insert "\n")) + ((and (vectorp (cdr el)) ; vector of strings (media types): + (not (seq-empty-p (cdr el))) + (< 1 (seq-length (cdr el))) + (stringp (seq-elt (cdr el) 0))) + (when ind (indent-to ind)) + (insert (mastodon-views--format-key el pad) + "\n" + (seq-mapcat + (lambda (x) (concat x ", ")) + (cdr el) 'string) + "\n\n")) + ((consp (cdr el)) ; basic nesting: + (when ind (indent-to ind)) + (insert (mastodon-views--format-key el pad) + "\n\n") + (mastodon-views--print-json-keys + (cdr el) (if ind (+ ind 4) 4))) + (t ; basic handling of raw booleans: + (let ((val (cond ((eq (cdr el) :json-false) + "no") + ((eq (cdr el) t) + "yes") + (t + (cdr el))))) + (when ind (indent-to ind)) + (insert (mastodon-views--format-key el pad) + " " + (mastodon-views--newline-if-long (cdr el)) + ;; only send strings to --render-text (for hyperlinks): + (mastodon-tl--render-text + (if (stringp val) val (prin1-to-string val))) + "\n")))))))) + +(defun mastodon-views--print-instance-rules-or-fields (alist) + "Print ALIST of instance rules or contact account or emoji fields." + (let-alist alist + (let ((key (or .id .name .shortcode)) + (value (or .text .value .url))) + (indent-to 4) + (insert (format "%-5s: " + (propertize key 'face '(:underline t))) + (mastodon-views--newline-if-long value) + (format "%s" (mastodon-tl--render-text + value)) + "\n")))) + +(defun mastodon-views--newline-if-long (el) + "Return a newline string if the cdr of EL is over 50 characters long." + (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) + (if (and (sequencep rend) + (< 50 (length rend))) + "\n" + ""))) + +(provide 'mastodon-views) +;;; mastodon-views.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon-widget.el b/elpa/mastodon-20260406.856/mastodon-widget.el new file mode 100644 index 00000000..e9376d8a --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon-widget.el @@ -0,0 +1,104 @@ +;;; mastodon-widget.el --- Widget utilities -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2024 Marty Hiatt +;; Author: Marty Hiatt +;; Maintainer: Marty Hiatt +;; 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 . + +;;; 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 diff --git a/elpa/mastodon-20260406.856/mastodon.el b/elpa/mastodon-20260406.856/mastodon.el new file mode 100644 index 00000000..8fa5837a --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon.el @@ -0,0 +1,652 @@ +;;; 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 +;; Author: Johnson Denen +;; Marty Hiatt +;; Maintainer: Marty Hiatt +;; Package-Version: 20260406.856 +;; Package-Revision: 5bba23045efd +;; Package-Requires: ((emacs "29.1") (persist "0.8") (tp "0.8")) +;; Homepage: https://codeberg.org/martianh/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see . + +;;; Commentary: + +;; mastodon.el is a client for fediverse services that implement the Mastodon +;; API. See . + +;; For set up and usage details, see the Info documentation, or the readme +;; file at . + +;;; Code: +(require 'cl-lib) ; for `cl-some' call in `mastodon' +(eval-when-compile (require 'subr-x)) +(require 'url) +(require 'thingatpt) +(require 'shr) + +(require 'mastodon-http) +(require 'mastodon-toot) +(require 'mastodon-search) +(require 'mastodon-transient) +(require 'mastodon-tl) + +(declare-function discover-add-context-menu "discover") +(declare-function emojify-mode "emojify") + +(autoload 'mastodon-auth--get-account-name "mastodon-auth") +(autoload 'mastodon-auth--user-acct "mastodon-auth") +(autoload 'mastodon-discover "mastodon-discover") +(autoload 'mastodon-notifications-follow-request-accept "mastodon-notifications") +(autoload 'mastodon-notifications-follow-request-reject "mastodon-notifications") +(autoload 'mastodon-notifications-get-mentions "mastodon-notifications") +(autoload 'mastodon-notifications--timeline "mastodon-notifications") +(autoload 'mastodon-notifications-policy "mastodon-notifications") +(autoload 'mastodon-notifications-requests "mastodon-notifications") +(autoload 'mastodon-profile--fetch-server-account-settings "mastodon-profile") +(autoload 'mastodon-profile-get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile-my-profile "mastodon-profile") +(autoload 'mastodon-profile-show-user "mastodon-profile") +(autoload 'mastodon-profile-update-user-profile-note "mastodon-profile") +(autoload 'mastodon-profile-view-bookmarks "mastodon-profile") +(autoload 'mastodon-profile-view-favourites "mastodon-profile") +(autoload 'mastodon-toot-edit-toot-at-point "mastodon-toot") +(when (require 'lingva nil :no-error) + (autoload 'mastodon-toot-translate-toot-text "mastodon-toot")) +(autoload 'mastodon-toot--view-toot-history "mastodon-tl") +(autoload 'mastodon-tl-return "mastodon-tl") +(autoload 'mastodon-tl-jump-to-followed-tag "mastodon-tl") +(autoload 'mastodon-notifications--update-with-timer "mastodon-notifications") +(autoload 'mastodon-profile-table-cell-hook-fun "mastodon-profile") + +;; for M-x visibility +;; (views.el uses `mastodon-mode-map', so we can't easily require it) +(autoload 'mastodon-views-view-follow-suggestions "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-view-filters "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-view-follow-requests "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-view-own-instance "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-view-instance-description "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-view-lists "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-view-scheduled-toots "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-add-account-to-list "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-add-toot-account-at-point-to-list "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-create-list "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-create-filter "mastodon-views" + nil :interactive) +(autoload 'mastodon-views-view-list-timeline "mastodon-views" + nil :interactive) + +(autoload 'special-mode "simple") +(autoload 'mastodon-tl--thread-do "mastodon-tl") +(autoload 'mastodon-notifications--get-unread-count "mastodon-notifications") + +(defvar mastodon-tl--highlight-current-toot) +(defvar mastodon-notifications--map) +(defvar mastodon-client--token-file) + +(defvar alert-default-style) +(defvar alert-styles) + +(defvar mastodon-notifications-grouped-types + '("reblog" "favourite") ;; TODO: implement follow! + "List of notification types for which grouping is implemented. +Used in `mastodon-notifications-get'") + +(defvar mastodon-notifications-notify-shown nil + "Whether recent notifications have been seen by the user or not.") + +(defgroup mastodon nil + "Interface with Mastodon." + :prefix "mastodon-" + :group 'external) + +(defcustom mastodon-instance-url "https://mastodon.social" + "Base URL for the fediverse instance you want to be active. +For example, if your username is +\"example_user@social.instance.org\", and you want this account +to be active, the value of this variable should be +\"https://social.instance.org\". + +Also for completeness, the value of `mastodon-active-user' should +be \"example_user\". + +After setting these variables you should restart Emacs for these +changes to take effect." + :type 'string) + +(defcustom mastodon-active-user nil + "Username of the active user. +For example, if your username is +\"example_user@social.instance.org\", and you want this account +to be active, the value of this variable should be +\"example_user\". + +Also for completeness, the value of `mastodon-instance-url' +should be \"https://social.instance.org\". + +After setting these variables you should restart Emacs for these +changes to take effect." + :type 'string) + +(defcustom mastodon-toot-timestamp-format "%F %T" + "Format to use for timestamps. +For valid formatting options see `format-time-string`. +The default value \"%F %T\" prints ISO8601-style YYYY-mm-dd HH:MM:SS. +Use. e.g. \"%c\" for your locale's date and time format." + :type 'string) + +(defcustom mastodon-use-emojify nil + "Whether to use emojify.el to display emojis. +From version 28, Emacs can display emojis natively. But +currently, it doesn't seem to have a way to handle custom emoji, +while emojify,el has this feature and mastodon.el implements it." + :type 'boolean) + +;; notifications customizes +;; moved here because we can load notifs without first loading mastodon.el +;; or mastodon-notifications.el + +(defcustom mastodon-profile-note-in-foll-reqs t + "If non-nil, show a user's profile note in follow request notifications." + :type '(boolean)) + +(defcustom mastodon-profile-note-in-foll-reqs-max-length nil + "The max character length for user profile note in follow requests. +Profile notes are only displayed if +`mastodon-profile-note-in-foll-reqs' is non-nil. +If unset, profile notes of any size will be displayed, which may +make them unweildy." + :type '(integer)) + +(defcustom mastodon-images-in-notifs nil + "Whether to display attached images in notifications." + :type '(boolean)) + +(defcustom mastodon-group-notifications nil + "Whether to use grouped notifications. +Requires that your instance actually implements grouped notifications. +Mastodon implemented them in 4.3." + :type '(boolean)) + +(defcustom mastodon-notifications-grouped-names-count 2 + "The number of notification authors to display. +A count of 2 for example means to display like so: \"Bob, Jenny +and X others...\"." + :type '(integer)) + +(defcustom mastodon-notifications-alerts-interval 60 + "How often to check for new notifications, in seconds." + :type '(integer)) + +(defcustom mastodon-notifications-alerts t + "Whether to enable alert.el unread-notification alerts. +If this is enabled and alert.el is installed, an alert.el notification +will be shown using `mastodon-notifications-alert-style' as its alert +style. If this is enabled but alert.el is not installed, alerts will be +shown using `message'. +Alerts are only checked for when at least 1 mastodon.el buffer is open." + :type '(boolean)) + +(defcustom mastodon-notifications-alert-style + (when (require 'alert nil :noerror) alert-default-style) + "The type of alert.el style to use for mastodon.el notification alerts. +Currently, if you customize this variable, you need to restart Emacs for +it to take effect, or if you don't have any other alert.el rules set up, +you can nil `alert-internal-configuration' and reload mastodon.el. This +only applies to alert.el alerts, if you don't use alert.el, you should +not set this variable and mastodon.el will message for notification +alerts." + :type + `(choice + ,@(if (not (require 'alert nil :noerror)) + '(const nil) + (append + '((const :tag "alert.el default" + :value alert-default-style)) + (cl-loop for x in alert-styles + collect (list 'const :tag (plist-get (cdr x) :title) + :value (car x))))))) + +(defun mastodon-kill-window () + "Quit window and delete helper." + (interactive) + (quit-window 'kill)) + +(defvar mastodon-client--active-user-details-plist) +(defvar mastodon-auth--token-alist) + +;;;###autoload +(defun mastodon-forget-all-logins () + "Delete `mastodon-client--token-file'. +Also nil `mastodon-auth--token-alist'." + (interactive) + (when (y-or-n-p "Remove all saved login data?") + (if (not (file-exists-p mastodon-client--token-file)) + (message "No plstore file") + (delete-file mastodon-client--token-file) + (message "File %s deleted." mastodon-client--token-file)) + ;; nil some vars too: + (setq mastodon-client--active-user-details-plist nil) + (setq mastodon-auth--token-alist nil))) + +(defvar mastodon-mode-map + (let ((map (make-sparse-keymap))) + ;; navigation inside a timeline + (define-key map (kbd "n") #'mastodon-tl-goto-next-item) + (define-key map (kbd "p") #'mastodon-tl-goto-prev-item) + (define-key map (kbd "M-n") #'mastodon-tl-next-tab-item) + (define-key map (kbd "M-p") #'mastodon-tl-previous-tab-item) + (define-key map [?\t] #'mastodon-tl-next-tab-item) + (define-key map [backtab] #'mastodon-tl-previous-tab-item) + (define-key map [?\S-\t] #'mastodon-tl-previous-tab-item) + (define-key map [?\M-\t] #'mastodon-tl-previous-tab-item) + (define-key map (kbd "l") #'recenter-top-bottom) + ;; navigation between timelines + (define-key map (kbd "#") #'mastodon-tl-get-tag-timeline) + (define-key map (kbd "C-#") #'mastodon-tl-list-followed-tags) + ;; (define-key map (kbd "\"") #'mastodon-tl-list-followed-tags) + (define-key map (kbd "C-\"") #'mastodon-tl-jump-to-followed-tag) + (define-key map (kbd "'") #'mastodon-tl-followed-tags-timeline) + (define-key map (kbd "C-'") #'mastodon-tl-tag-group-timeline) + (define-key map (kbd "A") #'mastodon-profile-get-toot-author) + (define-key map (kbd "F") #'mastodon-tl-get-federated-timeline) + (define-key map (kbd "H") #'mastodon-tl-get-home-timeline) + (define-key map (kbd "L") #'mastodon-tl-get-local-timeline) + (define-key map (kbd "N") #'mastodon-notifications-get) + (define-key map (kbd "S-C-n") #'mastodon-notifications-requests) + (define-key map (kbd "@") #'mastodon-notifications-get-mentions) + (define-key map (kbd "P") #'mastodon-profile-show-user) + (define-key map (kbd "s") #'mastodon-search-query) + (define-key map (kbd "/") #'mastodon-switch-to-buffer) + (define-key map (kbd "\\") #'mastodon-tl-get-remote-local-timeline) + ;; quitting mastodon + (define-key map (kbd "q") #'kill-current-buffer) + (define-key map (kbd "Q") #'mastodon-kill-window) + (define-key map (kbd "M-C-q") #'mastodon-kill-all-buffers) + ;; toot actions + (define-key map (kbd "c") #'mastodon-tl-toggle-spoiler-text-in-toot) + (define-key map (kbd "b") #'mastodon-toot-toggle-boost) + (define-key map (kbd "f") #'mastodon-toot-toggle-favourite) + (define-key map (kbd "k") #'mastodon-toot-toggle-bookmark) + (define-key map (kbd "r") #'mastodon-toot-reply) + (define-key map (kbd "\"") #'mastodon-toot-quote) + (define-key map (kbd "C") #'mastodon-toot-copy-toot-url) + (define-key map (kbd "o") #'mastodon-toot-browse-toot-url) + (define-key map (kbd "v") #'mastodon-tl-poll-vote) + (define-key map (kbd "E") #'mastodon-toot-view-toot-edits) + (define-key map (kbd "T") #'mastodon-tl-thread) + (define-key map (kbd "RET") #'mastodon-tl-return) + (define-key map (kbd "m") #'mastodon-tl-dm-user) + (define-key map (kbd "=") #'mastodon-tl-view-first-full-image) + (when (require 'lingva nil :no-error) + (define-key map (kbd "a") #'mastodon-toot-translate-toot-text)) + (define-key map (kbd ",") #'mastodon-toot-list-favouriters) + (define-key map (kbd ".") #'mastodon-toot-list-boosters) + (define-key map (kbd "C-,") #'mastodon-toot-jump-to-quoting) + (define-key map (kbd ";") #'mastodon-views-view-instance-description) + (define-key map (kbd "M-;") #'mastodon-tl-nodeinfo-for-toot) + ;; override special mode binding + (define-key map (kbd "g") #'undefined) + (define-key map (kbd "g") #'mastodon-tl-update) + ;; this is now duplicated by 'g', cd remove/use for else: + (define-key map (kbd "u") #'mastodon-tl-update) + ;; own toot actions: + (define-key map (kbd "t") #'mastodon-toot) + (define-key map (kbd "d") #'mastodon-toot-delete-toot) + (define-key map (kbd "D") #'mastodon-toot-delete-and-redraft-toot) + (define-key map (kbd "i") #'mastodon-toot-pin-toot-toggle) + (define-key map (kbd "e") #'mastodon-toot-edit-toot-at-point) + ;; user actions + (define-key map (kbd "W") #'mastodon-tl-follow-user) + (define-key map (kbd "C-S-W") #'mastodon-tl-unfollow-user) + (define-key map (kbd "B") #'mastodon-tl-block-user) + (define-key map (kbd "C-S-B") #'mastodon-tl-unblock-user) + (define-key map (kbd "M") #'mastodon-tl-mute-user) + (define-key map (kbd "C-S-M") #'mastodon-tl-unmute-user) + (define-key map (kbd "Z") #'mastodon-tl-report-to-mods) + ;; own profile + (define-key map (kbd "O") #'mastodon-profile-my-profile) + (define-key map (kbd "U") #'mastodon-profile-update-user-profile-note) + (define-key map (kbd "V") #'mastodon-profile-view-favourites) + (define-key map (kbd "K") #'mastodon-profile-view-bookmarks) + (define-key map (kbd ":") #'mastodon-user-settings) + (define-key map (kbd "C-:") #'mastodon-notifications-policy) + ;; minor views + (define-key map (kbd "R") #'mastodon-views-view-follow-requests) + (define-key map (kbd "S") #'mastodon-views-view-scheduled-toots) + (define-key map (kbd "I") #'mastodon-views-view-filters) + (define-key map (kbd "G") #'mastodon-views-view-follow-suggestions) + (define-key map (kbd "X") #'mastodon-views-view-lists) + (define-key map (kbd "SPC") #'mastodon-tl-scroll-up-command) + (define-key map (kbd "!") #'mastodon-tl-fold-post-toggle) + (define-key map (kbd "z") #'bury-buffer) + map) + "Keymap for `mastodon-mode'.") + +(defcustom mastodon-mode-hook nil + "Hook run when entering Mastodon mode." + :type 'hook + :options '(provide-discover-context-menu)) + +(defface mastodon-handle-face + '((t :inherit default)) + "Face used for user handles in bylines.") + +(defface mastodon-display-name-face + '((t :inherit warning)) + "Face used for user display names.") + +(defface mastodon-boosted-face + '((t :inherit success :weight bold)) + "Face to indicate that a toot is boosted.") + +(defface mastodon-boost-fave-face + '((t :inherit success)) + "Face to indicate that you have boosted or favourited a toot.") + +(defface mastodon-cw-face + '((t :inherit success)) + "Face used for content warning.") + +(defface mastodon-toot-docs-face + `((t :inherit shadow)) + "Face used for documentation in toot compose buffer. +If `mastodon-tl--enable-proportional-fonts' is changed, +mastodon.el needs to be re-loaded for this to be correctly set.") + +(defface mastodon-toot-docs-reply-text-face + `((t :inherit font-lock-comment-face + :family ,(face-attribute 'variable-pitch :family))) + "Face used for reply text in toot compose buffer. +See `mastodon-toot-display-orig-in-reply-buffer'.") + +(defface mastodon-cursor-highlight-face + `((t :inherit highlight :extend t)) + "Face for `mastodon-tl--highlight-current-toot'.") + +;;;###autoload +(defun mastodon () + "Connect client to `mastodon-instance-url' instance. +If there are any open mastodon.el buffers, switch to one instead. +Prority in switching is given to timeline views." + (interactive) + (let* ((tls (list "home" + "local" + "federated" + (concat (mastodon-auth--user-acct) "-statuses") ; own profile + "favourites" + "search")) + (buffer (or (cl-some (lambda (el) + (get-buffer (concat "*mastodon-" el "*"))) + tls) ; return first buff that exists + (cl-some (lambda (x) + (when (string-prefix-p "*mastodon-" + (buffer-name x)) + (get-buffer x))) + (buffer-list))))) ; catch any other masto buffer + (if buffer + (pop-to-buffer buffer '(display-buffer-same-window)) + ;; we need to update credential-account in case setting have been changed + ;; outside mastodon.el in the meantime: + (mastodon-return-credential-account :force) + (mastodon-tl-get-home-timeline) + (message "Loading fediverse account %s on %s..." + (mastodon-auth--user-acct) + mastodon-instance-url)))) + +(defvar mastodon-profile-credential-account nil) + +;; TODO: the get request in mastodon-http--get-response often returns nil +;; after waking from sleep, not sure how to fix, or if just my pc. +;; interestingly it only happens with this function tho. +(defun mastodon-return-credential-account (&optional force) + "Return the CredentialAccount entity. +Either from `mastodon-profile-credential-account' or from the +server if that var is nil. +FORCE means to fetch from the server in any case and update +`mastodon-profile-credential-account'." + (if (or force (not mastodon-profile-credential-account)) + (setq mastodon-profile-credential-account + ;; TODO: we should signal a quit condition after 5 secs here + (condition-case nil + (mastodon-http--get-json + (mastodon-http--api "accounts/verify_credentials") + nil :silent) + (t ; req fails, return old value + mastodon-profile-credential-account))) + ;; else just return the var: + mastodon-profile-credential-account)) + +(defvar mastodon-instance-data nil + "Instance data from the instance endpoint.") + +(defun mastodon-instance-data () + "Return `mastodon-instnace-data' or else fetch from instance endpoint." + (or mastodon-instance-data + (setq mastodon-instance-data + (mastodon-http--get-json (mastodon-http--api "instance"))))) + +(defun mastodon-instance-version () + "Return the version string of user's instance." + (alist-get 'version (mastodon-instance-data))) + +;;;###autoload +(defun mastodon-toot (&optional user reply-to-id reply-json + quote-id quote-json visibility) + "Update instance with new toot. Content is captured in a new buffer. +If USER is non-nil, insert after @ symbol to begin new toot. +If REPLY-TO-ID is non-nil, attach new toot to a conversation. +If REPLY-JSON is the json of the toot being replied to. +QUOTE-ID is the id of a toot being quoted, QUOTE-JSON is its data. +VISIBILITY is the visibility of the toot." + (interactive) + (mastodon-toot--compose-buffer user reply-to-id reply-json + nil nil quote-id quote-json visibility)) + +;;;###autoload +(defun mastodon-notifications-get (&optional type buffer-name max-id) + "Display NOTIFICATIONS in buffer. +Optionally only print notifications of type TYPE, a string. +BUFFER-NAME is added to \"*mastodon-\" to create the buffer name. +MAX-ID is a request parameter for pagination." + (interactive) + (let* ((buffer-name (or buffer-name "notifications")) + (buffer (concat "*mastodon-" buffer-name "*"))) + (message "Loading your notifications...") + (mastodon-tl--init-sync + buffer-name + "notifications" + 'mastodon-notifications--timeline + type + `(,@(when mastodon-group-notifications + (mastodon-http--build-array-params-alist + "grouped_types[]" mastodon-notifications-grouped-types)) + ,@(when max-id + `(("max_id" . ,(mastodon-tl--buffer-property 'max-id))))) + nil nil nil + (if (or (not mastodon-group-notifications) + ;; if version less than 1st grouped notifs release: + (> 4.3 (string-to-number + (mastodon-instance-version)))) + "v1" + "v2")) + (with-current-buffer (get-buffer-create buffer) + (use-local-map mastodon-notifications--map) + (when mastodon-notifications-notify-shown + (setq mastodon-notifications-notify-shown nil))) + (message "Loading your notifications... Done"))) + +;;;###autoload +(defun mastodon-notifications-check () + "Check for the number of unread notifications." + (interactive) + (let ((count (mastodon-notifications--get-unread-count))) + (message "Unread notifications: %s" count))) + +;; URL lookup: should be available even if `mastodon.el' not loaded: + +;;;###autoload +(defun mastodon-url-lookup (&optional query-url force) + "If a URL resembles a fediverse link, try to load in `mastodon.el'. +Does a WebFinger lookup on the server. +URL can be arg QUERY-URL, or URL at point, or provided by the user. +If a status or account is found, load it in `mastodon.el', if +not, just browse the URL in the normal fashion. +If FORCE, do a lookup regardless of the result of `mastodon--fedi-url-p'." + (interactive) + (let* ((query (or query-url + (mastodon-tl--property 'shr-url :no-move) + (thing-at-point-url-at-point) + (read-string "Lookup URL: ")))) + (if (and (not force) + (not (mastodon--fedi-url-p query))) + ;; (shr-browse-url query) ; doesn't work (keep our shr keymap) + (progn (message "Using external browser") + (browse-url query)) + (message "Performing lookup...") + (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) + (params `(("q" . ,query) + ("resolve" . "t"))) ; webfinger + (response (mastodon-http--get-json url params :silent))) + (cond ((not (seq-empty-p (alist-get 'statuses response))) + (let* ((statuses (assoc 'statuses response)) + (status (seq-first (cdr statuses))) + (status-id (alist-get 'id status))) + (mastodon-tl--thread-do status-id))) + ((not (seq-empty-p (alist-get 'accounts response))) + (let* ((accounts (assoc 'accounts response)) + (account (seq-first (cdr accounts)))) + (mastodon-profile--make-author-buffer account))) + (t + (message "Lookup failed. Using external browser") + (browse-url query))))))) + +(defun mastodon-url-lookup-force () + "Call `mastodon-url-lookup' without checking if URL is fedi-like." + (interactive) + (mastodon-url-lookup nil :force)) + +(defun mastodon--fedi-url-p (url) + "Check if QUERY resembles a fediverse URL." + ;; calqued off https://github.com/tuskyapp/Tusky/blob/c8fc2418b8f5458a817bba221d025b822225e130/app/src/main/java/com/keylesspalace/tusky/BottomSheetActivity.kt + ;; thx to Conny Duck! + ;; mastodon at least seems to allow only [a-z0-9_] for usernames, plus "." + ;; but not at beginning or end, see https://github.com/mastodon/mastodon/issues/6830 + ;; objects may have - in them + (let* ((uri-parsed (url-generic-parse-url url)) + (query (url-filename uri-parsed))) + (save-match-data + (or (string-match "^/@[^/]+$" query) + (string-match "^/@[^/]+/[[:digit:]]+$" query) + (string-match "^/user[s]?/@?[[:alnum:]_]+$" query) ; @: pleroma or soapbox + (string-match "^/notice/[[:alnum:]]+$" query) + (string-match "^/objects/[-a-f0-9]+$" query) + (string-match "^/notes/[a-z0-9]+$" query) + (string-match "^/display/[-a-f0-9]+$" query) + (string-match "^/profile/[[:alpha:]_]+$" query) + (string-match "^/p/[[:alpha:]_]+/[[:digit:]]+$" query) + (string-match "^/[[:alpha:]_]+$" query) + (string-match "^/u/[[:alpha:]_]+$" query) + (string-match "^/c/[[:alnum:]_]+$" query) + (string-match "^/post/[[:digit:]]+$" query) + (string-match "^/comment/[[:digit:]]+$" query) ; lemmy + (string-match "^/@[^/]+/statuses/[[:alnum:]]" query) ; GTS + (string-match "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" query) ; hometown + (string-match "^/notes/[[:alnum:]]+$" query) ; misskey post + (string-match "^/w/[[:alnum:]_]+$" query) ; peertube post + ;; bsky via fed.brid.gy (unsure if this needs narrowing down?): + (string-prefix-p "https://fed.brid.gy/r/" url))))) + +(defun mastodon-live-buffers () + "Return a list of open mastodon buffers. +Calls `mastodon-tl--get-buffer-type', which see." + (cl-loop for x in (buffer-list) + when (with-current-buffer x (mastodon-tl--get-buffer-type)) + collect (get-buffer x))) + +(defun mastodon-buffer-p (&optional buffer) + "Non-nil if BUFFER or `current-buffer' is a mastodon one." + (let ((buf (or buffer (current-buffer)))) + (member buf (mastodon-live-buffers)))) + +(defun mastodon-kill-all-buffers () + "Kill any and all open mastodon buffers, hopefully." + (interactive) + (let ((mastodon-buffers (mastodon-live-buffers))) + (cl-loop for x in mastodon-buffers + do (kill-buffer x)))) + +(defun mastodon-switch-to-buffer () + "Switch to a live mastodon buffer." + (interactive) + (let ((choice (completing-read + "Switch to mastodon buffer: " + (mapcar #'buffer-name (mastodon-live-buffers)) + nil :match))) + (switch-to-buffer choice))) + +(defun mastodon--url-at-point () + "`thing-at-point' provider function." + (get-text-property (point) 'shr-url)) + +(defun mastodon-mode-hook-fun () + "Function to add to `mastodon-mode-hook'." + (when (and mastodon-use-emojify + (require 'emojify nil :noerror)) + (emojify-mode t) + (when mastodon-toot--enable-custom-instance-emoji + (mastodon-toot-enable-custom-emoji))) + (mastodon-profile--fetch-server-account-settings) + (when (and mastodon-tl--highlight-current-toot + (fboundp #'cursor-face-highlight-mode)) + (cursor-face-highlight-mode)) ; 29.1 + ;; make `thing-at-point' functions work: + (setq-local thing-at-point-provider-alist + (append thing-at-point-provider-alist + '((url . mastodon--url-at-point)))) + ;; notifs timer + (when mastodon-notifications-alerts + (mastodon-notifications--update-with-timer)) + ;; pretty table override bindings: + (add-hook 'table-cell-map-hook + #'mastodon-profile-table-cell-hook-fun + nil :local)) + +;;;###autoload +(add-hook 'mastodon-mode-hook #'mastodon-mode-hook-fun) + +(define-derived-mode mastodon-mode special-mode "Mastodon" + "Major mode for fediverse services using the Mastodon API." + (read-only-mode 1)) + +(provide 'mastodon) +;;; mastodon.el ends here diff --git a/elpa/mastodon-20260406.856/mastodon.info b/elpa/mastodon-20260406.856/mastodon.info new file mode 100644 index 00000000..ca01e7e8 --- /dev/null +++ b/elpa/mastodon-20260406.856/mastodon.info @@ -0,0 +1,885 @@ +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 + + +File: mastodon.info, Node: Top, Next: README, Up: (dir) + +A Mastodon client +***************** + +* Menu: + +* README:: + +— The Detailed Node Listing — + +README + +* Installation:: +* Usage:: +* Dependencies:: +* Network compatibility:: +* Contributing:: +* Supporting ‘mastodon.el’: Supporting mastodonel. +* Contributors:: +* Screenshots:: + +Installation + +* ELPA:: +* MELPA:: +* Repo:: +* Emoji:: +* Discover:: + +Usage + +* Logging in to your instance:: +* Timelines:: +* Composing toots:: +* Other commands and account settings:: +* Notifications:: +* Customization:: +* Commands and variables index:: +* Packages related to ‘mastodon.el’: Packages related to mastodonel. +* Live-updating timelines mastodon-async-mode:: +* Translating toots:: +* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel. + +Contributing + +* Bug reports:: +* Fixes and features:: +* Coding style:: + + + +File: mastodon.info, Node: README, Prev: Top, Up: Top + +1 README +******** + +‘mastodon.el’ is an Emacs client for the ActivityPub social networks +that implement the Mastodon API. For info see joinmastodon.org +(https://joinmastodon.org/). + + NB: ‘mastodon.el’ now ships this readme as an .info file, so if you +have it installed you should be able to browse this readme inside emacs. +‘C-h i’ for info, then ‘m masto RET’ should load it for you. + +* Menu: + +* Installation:: +* Usage:: +* Dependencies:: +* Network compatibility:: +* Contributing:: +* Supporting ‘mastodon.el’: Supporting mastodonel. +* Contributors:: +* Screenshots:: + + +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:: + + +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’ + + +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’ + + +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. + + +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. + + +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)) + + +File: mastodon.info, Node: Usage, Next: Dependencies, Prev: Installation, Up: README + +1.2 Usage +========= + +* Menu: + +* Logging in to your instance:: +* Timelines:: +* Composing toots:: +* Other commands and account settings:: +* Notifications:: +* Customization:: +* Commands and variables index:: +* Packages related to ‘mastodon.el’: Packages related to mastodonel. +* Live-updating timelines mastodon-async-mode:: +* Translating toots:: +* Bookmarks and ‘mastodon.el’: Bookmarks and mastodonel. + + +File: mastodon.info, Node: Logging in to your instance, Next: Timelines, Up: Usage + +1.2.1 Logging in to your instance +--------------------------------- + +You need to set 2 variables in your init file to get started: + + 1. ‘mastodon-instance-url’ + 2. ‘mastodon-active-user’ + + (see their doc strings for details). For example If you want to post +toots as "example_user@social.instance.org", then put this in your init +file: + + (setq mastodon-instance-url "https://social.instance.org" + mastodon-active-user "example_user") + + Then *restart* Emacs and run ‘M-x mastodon’. Make sure you are +connected to internet before you do this. If you have multiple mastodon +accounts you can activate one at a time by changing those two variables +and restarting Emacs. + + If you were using mastodon.el before 2FA was implemented and the +above steps do not work, call ‘(mastodon-forget-all-logins)’, restart +Emacs and follow the steps again. + + 1. encrypted access tokens (from 2.0.0) + + By default, user access tokens are now stored in the user’s auth + source file (typically ‘~/.authinfo.gpg’, check the value of + ‘auth-sources’). When you first update to 2.0.0, or if you + encounter issues due to old credentials, call + ‘(mastodon-forget-all-logins)’ to remove the old mastodon.el + plstore, and then authenticate again. If you don’t want to use the + auth source file, set ‘mastodon-auth-use-auth-source’ to nil. + Entries will instead be stored encrypted in + ‘mastodon-client--token-file’, a plstore. + + If for some reason you reauthenticate, you’ll need to either remove + the entry in your auth sources file, or manually update the token + in it after doing so, as mastodon.el is unable to reliably update + (or even remove) entries. + + The format for a mastodon.el auth source entry is as follows: + + ‘machine INSTANCE login USERNAME password AUTHTOKEN’ + + with the token being what you copy from the browser when + authenticating. If you have ‘auth-source-save-behavior’ set to + nil, you’ll also need to add such an entry manually. + + Finally, if you find you’re asked for your key passphrase too often + while authenticating, consider setting ‘epa-file-encrypt-to’ (for + auth-source encryption) and ‘plstore-encrypt-to’ (for plstore + encryption) to your preferred key ID. + + +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/’ Go to the next interesting thing that has an action + ‘M-p/’ Go to the previous interesting thing that has an action + ‘F’ Open federated timeline (1 prefix arg: hide-replies, 2 prefix args: media only) + ‘H’ Open home timeline (1 prefix arg: hide-replies) + ‘L’ Open local timeline (1 prefix arg: hide-replies, 2 prefix args: media only) + ‘N’ Open notifications timeline + ‘@’ Open mentions-only notifications timeline + ‘u’ Update current timeline + ‘T’ Open thread for toot at point + ‘#’ Prompt for tag and open its timeline + ‘A’ Open author profile of toot at point + ‘P’ Open profile of user attached to toot at point + ‘O’ View own profile + ‘U’ update your profile bio note + ‘;’ view instance description for toot at point + ‘:’ view followed tags and load a tag timeline + ‘C-:’ view timeline of all followed tags + ‘,’ view favouriters of toot at point + ‘.’ view boosters of toot at point + ‘/’ switch between mastodon buffers + ‘\’ prompt for an instance domain and view its local timeline (if poss) + ‘Z’ report user/toot at point to instances moderators + *Other views* + ‘s’ search (posts, users, tags) (NB: only posts you have interacted with) + ‘I’, ‘c’, ‘d’ view, create, and delete filters + ‘R’, ‘a’, ‘j’ view/accept/reject follow requests + ‘G’ view follow suggestions + ‘V’ view your favourited toots + ‘K’ view bookmarked toots + ‘X’ view/edit/create/delete lists + ‘S’ view your scheduled toots + ‘S-:’ view profile/account settings transient menu + *Toot actions* + ‘t’ Compose a new toot + ‘c’ Toggle content warning content + ‘b’ Boost toot under ‘point’ + ‘f’ Favourite toot under ‘point’ + ‘k’ toggle bookmark of toot at point + ‘r’ Reply to toot under ‘point’ + ‘v’ Vote on poll at point + ‘C’ copy url of toot at point + ‘C-RET’ play video/gif at point (requires ‘mpv’) + ‘e’ edit your toot at point + ‘E’ view edits of toot at point + ‘i’ (un)pin your toot at point + ‘d’ delete your toot at point, and reload current timeline + ‘D’ delete and redraft toot at point, preserving reply/CW/visibility + ‘!’ toggle folding of toot at point + (‘S-C-’) ‘W’, ‘M’, ‘B’ (un)follow, (un)mute, (un)block author of toot at point + *Profile view* + ‘C-c C-c’ cycle between statuses, statuses without boosts, followers, and following + ‘mastodon-profile--add-account-to-list’ (see lists view) + *Notifications view* + ‘a’, ‘j’ accept/reject follow request + ‘C-k’ clear notification at point + ‘C-c C-c’ cycle between notification types + see ‘mastodon-notifications--get-*’ functions for filtered views + *Quitting* + ‘q’ Quit mastodon buffer, leave window open + ‘Q’ Quit mastodon buffer and kill window + ‘C-M-q’ Quit and kill all mastodon buffers + + 2. Toot byline legend + + Marker Meaning + -------------------------------------------- + ‘(🔁)’ (or I boosted this toot + ‘(B)’) + ‘(⭐)’ (or I favourited this toot + ‘(F)’) + ‘(🔖)’ (or I bookmarked this toot + ‘(K)’) + + +File: mastodon.info, Node: Composing toots, Next: Other commands and account settings, Prev: Timelines, Up: Usage + +1.2.3 Composing toots +--------------------- + +‘M-x mastodon-toot’ (or ‘t’ from a mastodon.el buffer) opens a new +buffer/window in ‘text-mode’ and ‘mastodon-toot’ minor mode. Enter the +contents of your toot here. ‘C-c C-c’ sends the toot. ‘C-c C-k’ +cancels. Both actions kill the buffer and window. Further keybindings +are displayed in the buffer, and in the following subsection. + + Replies preserve visibility status/content warnings, and include +boosters by default. If the region is active when you start a reply, it +will be yanked into the compose buffer prefixed with ‘>’ to form a rough +reply quote. + + Server’s max toot length, with running char count, and attachment +previews, are shown. + + You can download and use your instance’s custom emoji +(‘mastodon-toot--download-custom-emoji’, +‘mastodon-toot--enable-custom-emoji’). + + If you want to view some of the toot being replied to in the compose +buffer, set ‘mastodon-toot-display-orig-in-reply-buffer’ to non-nil. + + The compose buffer uses ‘text-mode’ so any configuration you have for +that mode will be enabled. If any of your existing config conflicts +with ‘mastodon-toot’, you can disable it in the +‘mastodon-toot-mode-hook’. For example, the default value of that hook +is as follows: + + (add-hook 'mastodon-toot-mode-hook + (lambda () + (auto-fill-mode -1))) + + 1. Keybindings + + Key Action + -------------------------------------------- + ‘C-c C-c’ Send toot + ‘C-c C-k’ Cancel toot + ‘C-c C-w’ Add content warning + ‘C-c C-v’ Change toot visibility + ‘C-c C-n’ Add sensitive media/nsfw flag + ‘C-c C-a’ Upload attachment(s) + ‘C-c !’ Remove all attachments + ‘C-c C-e’ Insert emoji + ‘C-c C-p’ Create a poll + ‘C-c C-o’ Cancel poll + ‘C-c C-l’ Set toot language + ‘C-c C-s’ Schedule toot + + 2. Autocompletion of mentions, tags and emoji + + Autocompletion of mentions, tags, and emojis is provided by + ‘completion-at-point-functions’ (capf) backends. + ‘mastodon-toot--enable-completion’ is enabled by default. + + To trigger completion, type a prefix followed by a few letters, ‘@’ + for mentions, ‘#’ for tags, and ‘:’ for emoji (for now this only + works when using ‘emojify.el’). + + If you want to enable ‘company-mode’ in the toot compose buffer, + set ‘mastodon-toot--use-company-for-completion’ to ‘t’. + (‘mastodon.el’ used to run its own native company backends, but + these have been removed in favour of capfs.) + + If you don’t run ‘company’ and want immediate, keyless completion, + you’ll need to have another completion engine running that handles + capfs. A common combination is ‘consult’ and ‘corfu’. + + 3. Draft toots + + • Compose buffer text is saved as you type, kept in + ‘mastodon-toot-current-toot-text’. + • ‘mastodon-toot--save-draft’: save the current toot as a draft. + • ‘mastodon-toot--open-draft-toot’: Open a compose buffer and + insert one of your draft toots. + • ‘mastodon-toot--delete-draft-toot’: Delete a draft toot. + • ‘mastodon-toot--delete-all-drafts’: Delete all your drafts. + + +File: mastodon.info, Node: Other commands and account settings, Next: Notifications, Prev: Composing toots, Up: Usage + +1.2.4 Other commands and account settings: +------------------------------------------ + +In addition to ‘mastodon’, the following three functions are autoloaded +and should work without first loading a ‘mastodon.el’ buffer: + • ‘mastodon-toot’: Compose new toot + • ‘mastodon-notifications-get’: View all notifications + • ‘mastodon-url-lookup’: Attempt to load a URL in ‘mastodon.el’. URL + may be at point or provided in the minibuffer. + + • ‘mastodon-tl--view-instance-description’: View information about + the instance that the author of the toot at point is on. + • ‘mastodon-tl--view-own-instance’: View information about your own + instance. + • ‘mastodon-search--trending-tags’: View a list of trending hashtags + on your instance. + • ‘mastodon-search--trending-statuses’: View a list of trending + statuses on your instance. + • ‘mastodon-search--trending-links’: View a list of trending links on + your instance (+ click through to a timeline of posts featuring a + given link) + + • ‘mastodon-tl--add-toot-account-at-point-to-list’: Add the account + of the toot at point to a list. + + • ‘mastodon-tl--dm-user’: Send a direct message to one of the users + at point. + + • ‘mastodon-profile--add-private-note-to-account’: Add a private note + to another user’s account. + • ‘mastodon-profile--view-account-private-note’: View a private note + on a user’s account. + + • ‘mastodon-profile--show-familiar-followers’: Show a list of + “familiar followers” for a given account. Familiar followers are + accounts that you follow, and that follow the account. + + • ‘mastodon-tl--follow-tag’: Follow a tag (works like following a + user) + • ‘mastodon-tl--unfollow-tag’: Unfollow a tag + • ‘mastodon-tl--list-followed-tags’: View a list of tags you’re + following. + • ‘mastodon-tl--followed-tags-timeline’: View a timeline of all your + followed tags. + • ‘mastodon-tl--some-followed-tags-timleine’: View a timeline of + multiple tags, from your followed tags or any other. + + • ‘mastodon-switch-to-buffer’: switch between mastodon buffers. + + • ‘mastodon-tl--get-remote-local-timeline’: View a local timeline of + a remote instance. + • ‘mastodon-tl--remote-tag-timeline’: View a tag timeline on a remote + instance. + + • ‘mastodon-user-settings’: Launch a transient menu to update various + account settings. + + +File: mastodon.info, Node: Notifications, Next: Customization, Prev: Other commands and account settings, Up: Usage + +1.2.5 Notifications +------------------- + +Mastodon from 4.3 supports grouped notifications. These are implemented +by ‘mastodon.el’ but disabled by default out of consideration to users +on instances that don’t support them. If you are on an instance that +implements grouped notifications, set ‘mastodon-group-notifications’ to +‘t’ to enable them. + + +File: mastodon.info, Node: Customization, Next: Commands and variables index, Prev: Notifications, Up: Usage + +1.2.6 Customization +------------------- + +See ‘M-x customize-group RET mastodon’ to view all customize options. + + • Timeline options: + • Use proportional fonts + • Default number of posts displayed + • Timestamp format + • Relative timestamps + • Display user avatars + • Avatar image height + • Enable image caching + • Hide replies in timelines + • Show toot stats in byline + + • Compose options: + • Completion style for mentions and tags + • Enable custom emoji + • Display toot being replied to + • Set default reply visibility + + • Nofitication options: + • Display user’s profile note in follow requests + • Group notifications + + +File: mastodon.info, Node: Commands and variables index, Next: Packages related to mastodonel, Prev: Customization, Up: Usage + +1.2.7 Commands and variables index +---------------------------------- + +An index of all user-facing commands and custom variables is available +here: mastodon-index.org (mastodon-index.org). + + You can also hit ‘?’ in any ‘mastodon.el’ buffer to see the available +bindings, or run ‘M-X’ (upper-case ‘X’) to view all commands in the +buffer with completion, and call one. + + +File: mastodon.info, Node: Packages related to mastodonel, Next: Live-updating timelines mastodon-async-mode, Prev: Commands and variables index, Up: Usage + +1.2.8 Packages related to ‘mastodon.el’ +--------------------------------------- + + 1. Alternative timeline layout + + The incomparable Nicholas Rougier has written an alternative + timeline layout for ‘mastodon.el’. + + The repo is at mastodon-alt + (https://github.com/rougier/mastodon-alt). + + 2. Org links, archive search + + toot-suite (https://codeberg.org/chrmoe/toot-suite) implements an + org link type for fediverse posts, and also provides a way to + browse an offline archive of your account. + + 3. Mastodon hydra + + A user made a hydra for handling basic ‘mastodon.el’ commands. + It’s available at + . + + 4. Narrow to timeline item + + A simple code snippet to enable narrowing to current item in + timelines: + + + 5. Sachac’s config goodies + + The incomparable sachac has a bunch of ‘mastodon.el’ extensions and + goodies in their literate config, available here: + . + + +File: mastodon.info, Node: Live-updating timelines mastodon-async-mode, Next: Translating toots, Prev: Packages related to mastodonel, Up: Usage + +1.2.9 Live-updating timelines: ‘mastodon-async-mode’ +---------------------------------------------------- + +(code taken from mastodon-future +(https://github.com/alexjgriffith/mastodon-future.el).) + + Works for federated, local, and home timelines and for notifications. +It’s a little touchy, one thing to avoid is trying to load a timeline +more than once at a time. It can go off the rails a bit, but it’s still +pretty cool. The current maintainer of ‘mastodon.el’ is unable to debug +or improve this feature. + + To enable, it, add ‘(require 'mastodon-async)’ to your ‘init.el’. +Then you can view a timeline with one of the commands that begin with +‘mastodon-async--stream-’. + + +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?")))) + + +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. + + +File: mastodon.info, Node: Dependencies, Next: Network compatibility, Prev: Usage, Up: README + +1.3 Dependencies +================ + +Hard dependencies (should all install with ‘mastodon.el’): + • ‘request’ (for uploading attachments, emacs-request + (https://github.com/tkf/emacs-request)) + • ‘persist’ (for storing some settings across sessions, persist + (https://elpa.gnu.org/packages/persist.html)) + • ‘tp.el’ (for transient menus, tp.el + (https://codeberg.org/martianh/tp.el)) + + Optional dependencies (install yourself, ‘mastodon.el’ can use them): + • ‘emojify’ to use custom emoji (else we use builtin ‘emoji.el’) + • ‘mpv’ and ‘mpv.el’ for viewing videos and gifs + • ‘lingva.el’ for translating toots + + +File: mastodon.info, Node: Network compatibility, Next: Contributing, Prev: Dependencies, Up: README + +1.4 Network compatibility +========================= + +‘mastodon.el’ should work with ActivityPub servers that implement the +Mastodon API. + + Apart from Mastodon itself, it is currently known to work with: + • Pleroma (pleroma.social (https://pleroma.social/)) + • Akkoma (akkoma.social (https://akkoma.social/)) + • Gotosocial (gotosocial.org (https://gotosocial.org/)) + • Sharkey (joinsharkey.org (https://joinsharkey.org)) + + It does not support the non-Mastodon API servers Misskey (misskey.io +(https://misskey.io/)), Firefish (joinfirefish.org +(https://joinfirefish.org/), formerly Calkey) and Friendica, but it +should fully support displaying and interacting with posts and users on +those platforms. + + If you attempt to use ‘mastodon.el’ with a server and run into +problems, feel free to open an issue. + + +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:: + + +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. + + +File: mastodon.info, Node: Fixes and features, Next: Coding style, Prev: Bug reports, Up: Contributing + +1.5.2 Fixes and features +------------------------ + + 1. Install Cask + (https://cask.readthedocs.io/en/latest/guide/installation.html) if + you don’t already have it installed + 2. Create an issue (https://codeberg.org/martianh/mastodon.el/issues) + detailing what you’d like to do. + 3. Fork the repository and create a branch off of ‘develop’. + 4. Run the tests (with ‘make tests’) and ensure that your code doesn’t + break any of them. + 5. Create a pull request (to develop) referencing the issue created in + step 2. + + +File: mastodon.info, Node: Coding style, Prev: Fixes and features, Up: Contributing + +1.5.3 Coding style +------------------ + + • This library uses an unconvential double dash (‘--’) between file + namespaces and function names, which contradicts normal Elisp + style. This needs to be respected until the whole library is + changed. + • Use ‘aggressive-indent-mode’ or similar to keep your code indented. + • Single spaces end sentences in docstrings. + • There’s no need for a blank line after the first docstring line + (one is added automatically when documentation is displayed). + + +File: mastodon.info, Node: Supporting mastodonel, Next: Contributors, Prev: Contributing, Up: README + +1.6 Supporting ‘mastodon.el’ +============================ + +If you’d like to support continued development of ‘mastodon.el’, I +accept donations via paypal: paypal.me/martianh +(https://paypal.me/martianh). + + I also accept support via liberapay: + + If you would prefer a different payment method, please write to me at + 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. + + +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: + + • [original author] + • + • + • + • + + +File: mastodon.info, Node: Screenshots, Prev: Contributors, Up: README + +1.8 Screenshots +=============== + +Here’s a (federated) timeline: + +[image src="screenshot-tl.png"] + + + Here’s a notifcations view plus a compose buffer: + +[image src="screenshot-notifs+compose.png"] + + + Here’s a user settings transient (active values green, current server +values commented and, if a boolean, underlined): + +[image src="screenshot-transient-1.jpg"] + + + Here’s a user profile fields transient (changed fields green, current +server values commented): + +[image src="screenshot-transient-2.jpg"] + + + + +Tag Table: +Node: Top219 +Node: README1083 +Node: Installation1732 +Node: ELPA2021 +Node: MELPA2249 +Node: Repo2629 +Node: Emoji3122 +Node: Discover3716 +Node: Usage4268 +Node: Logging in to your instance4770 +Ref: encrypted access tokens (from 200)5742 +Node: Timelines7200 +Ref: Keybindings7675 +Ref: Toot byline legend12657 +Node: Composing toots12966 +Ref: Keybindings (1)14518 +Ref: Autocompletion of mentions tags and emoji15073 +Ref: Draft toots15998 +Node: Other commands and account settings16469 +Node: Notifications19144 +Node: Customization19629 +Node: Commands and variables index20517 +Node: Packages related to mastodonel21036 +Ref: Alternative timeline layout21289 +Ref: Org links archive search21516 +Ref: Mastodon hydra21735 +Ref: Narrow to timeline item21919 +Ref: Sachac's config goodies22126 +Node: Live-updating timelines mastodon-async-mode22345 +Node: Translating toots23200 +Node: Bookmarks and mastodonel24383 +Node: Dependencies24925 +Node: Network compatibility25711 +Node: Contributing26652 +Node: Bug reports27148 +Node: Fixes and features28059 +Node: Coding style28722 +Node: Supporting mastodonel29346 +Node: Contributors29947 +Node: Screenshots30382 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: