Mercurial > hg > dotemacs
changeset 188:cf476cceb7b2
mastodon: new package
| author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
|---|---|
| date | Wed, 13 Feb 2019 15:38:33 -0500 |
| parents | 0d9b78e20f77 |
| children | 4bb68b30325b |
| files | dotemacs.el elpa/mastodon-0.8.0/mastodon-auth.el elpa/mastodon-0.8.0/mastodon-autoloads.el elpa/mastodon-0.8.0/mastodon-client.el elpa/mastodon-0.8.0/mastodon-http.el elpa/mastodon-0.8.0/mastodon-inspect.el elpa/mastodon-0.8.0/mastodon-media.el elpa/mastodon-0.8.0/mastodon-notifications.el elpa/mastodon-0.8.0/mastodon-pkg.el elpa/mastodon-0.8.0/mastodon-profile.el elpa/mastodon-0.8.0/mastodon-tl.el elpa/mastodon-0.8.0/mastodon-toot.el elpa/mastodon-0.8.0/mastodon.el elpa/mastodon-readme.txt |
| diffstat | 14 files changed, 2682 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- a/dotemacs.el +++ b/dotemacs.el @@ -426,7 +426,7 @@ ("gnu" . "http://elpa.gnu.org/packages/")))) '(package-selected-packages (quote - (systemd fountain-mode markdown-mode magit js2-mode yaml-mode web-mode undo-tree puppet-mode nginx-mode json-mode jade-mode idomenu haml-mode goto-last-change flymake-haml elpy dockerfile-mode))) + (mastodon systemd fountain-mode markdown-mode magit js2-mode yaml-mode web-mode undo-tree puppet-mode nginx-mode json-mode jade-mode idomenu haml-mode goto-last-change flymake-haml elpy dockerfile-mode))) '(safe-local-variable-values (quote ((encoding . utf-8)
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-auth.el @@ -0,0 +1,150 @@ +;;; mastodon-auth.el --- Auth functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Homepage: https://github.com/jdenen/mastodon.el +;; Package-Requires: ((emacs "24.4")) + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-auth.el supports authorizing and authenticating with Mastodon. + +;;; Code: + +(require 'plstore) +(require 'auth-source) + +(autoload 'mastodon-client "mastodon-client") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(defvar mastodon-instance-url) + +(defgroup mastodon-auth nil + "Authenticate with Mastodon." + :prefix "mastodon-auth-" + :group 'mastodon) + +(defcustom mastodon-auth-source-file "" + "Filename to use to store user names and passwords. + +Leave empty to not permanently store any secrets. +Otherwise set to e.g. \"~/.authinfo.gpg\" to have encrypted storage, or +if you are happy with unencryped storage use e.g. \"~/authinfo\"." + :group 'mastodon-auth + :type 'string) + +(defvar mastodon-auth--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.") + +(defun mastodon-auth--generate-token () + "Make POST to generate auth token." + (if (or (null mastodon-auth-source-file) + (string= "" mastodon-auth-source-file)) + (mastodon-auth--generate-token-no-storing-credentials) + (mastodon-auth--generate-token-and-store))) + +(defun mastodon-auth--generate-token-no-storing-credentials () + "Make POST to generate auth token." + (mastodon-http--post + (concat mastodon-instance-url "/oauth/token") + `(("client_id" . ,(plist-get (mastodon-client) :client_id)) + ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" . "password") + ("username" . ,(read-string "Email: ")) + ("password" . ,(read-passwd "Password: ")) + ("scope" . "read write follow")) + nil + :unauthenticated)) + +(defun mastodon-auth--generate-token-and-store () + "Make POST to generate auth token. + +Reads and/or stores secres in `MASTODON-AUTH-SOURCE-FILE'." + (let* ((auth-sources (list mastodon-auth-source-file)) + (auth-source-creation-prompts + '((user . "Enter email for %h: ") + (secret . "Password: "))) + (credentials-plist (nth 0 (auth-source-search + :create t + :host mastodon-instance-url + :port 443 + :require '(:user :secret))))) + (prog1 + (mastodon-http--post + (concat mastodon-instance-url "/oauth/token") + `(("client_id" . ,(plist-get (mastodon-client) :client_id)) + ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" . "password") + ("username" . ,(plist-get credentials-plist :user)) + ("password" . ,(let ((secret (plist-get credentials-plist :secret))) + (if (functionp secret) + (funcall secret) + secret))) + ("scope" . "read write follow")) + nil + :unauthenticated) + (when (functionp (plist-get credentials-plist :save-function)) + (funcall (plist-get credentials-plist :save-function)))))) + +(defun mastodon-auth--get-token () + "Make auth token request and return JSON response." + (with-current-buffer (mastodon-auth--generate-token) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-object-type 'plist) + (json-key-type 'keyword) + (json-array-type 'vector) + (json-string (buffer-substring-no-properties (point) (point-max)))) + (json-read-from-string json-string)))) + +(defun mastodon-auth--access-token () + "Return the access token to use with the current `mastodon-instance-url'. + +Generate token and set if none known yet." + (let ((token + (cdr (assoc mastodon-instance-url mastodon-auth--token-alist)))) + (unless token + (let ((json (mastodon-auth--get-token))) + (setq token (plist-get json :access_token)) + (push (cons mastodon-instance-url token) mastodon-auth--token-alist))) + token)) + +(defun mastodon-auth--get-account-name () + "Request user credentials and return an account name." + (cdr (assoc + 'acct + (mastodon-http--get-json + (mastodon-http--api + "accounts/verify_credentials"))))) + +(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
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-autoloads.el @@ -0,0 +1,40 @@ +;;; mastodon-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) + +;;;### (autoloads nil "mastodon" "mastodon.el" (23637 51629 673966 +;;;;;; 313000)) +;;; Generated autoloads from mastodon.el + +(autoload 'mastodon "mastodon" "\ +Connect Mastodon client to `mastodon-instance-url' instance. + +\(fn)" t nil) + +(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. + +\(fn &optional USER REPLY-TO-ID)" t nil) + +(add-hook 'mastodon-mode-hook (lambda nil (when (require 'emojify nil :noerror) (emojify-mode t)))) + +;;;*** + +;;;### (autoloads nil nil ("mastodon-auth.el" "mastodon-client.el" +;;;;;; "mastodon-http.el" "mastodon-inspect.el" "mastodon-media.el" +;;;;;; "mastodon-notifications.el" "mastodon-pkg.el" "mastodon-profile.el" +;;;;;; "mastodon-tl.el" "mastodon-toot.el") (23637 51629 749967 +;;;;;; 493000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; mastodon-autoloads.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-client.el @@ -0,0 +1,111 @@ +;;; mastodon-client.el --- Client functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Homepage: https://github.com/jdenen/mastodon.el +;; Package-Requires: ((emacs "24.4")) + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-client.el supports registering the Emacs client with your Mastodon instance. + +;;; Code: + +(require 'plstore) +(defvar mastodon-instance-url) +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") + + +(defcustom mastodon-client--token-file (concat user-emacs-directory "mastodon.plstore") + "File path where Mastodon access tokens are stored." + :group 'mastodon + :type 'file) + +(defvar mastodon-client--client-details-alist nil + "An alist of Client id and secrets keyed by the instance url.") + +(defun mastodon-client--register () + "POST client to Mastodon." + (mastodon-http--post + (mastodon-http--api "apps") + '(("client_name" . "mastodon.el") + ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") + ("scopes" . "read write follow") + ("website" . "https://github.com/jdenen/mastodon.el")) + nil + :unauthenticated)) + +(defun mastodon-client--fetch () + "Return JSON from `mastodon-client--register' call." + (with-current-buffer (mastodon-client--register) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-object-type 'plist) + (json-key-type 'keyword) + (json-array-type 'vector) + (json-string (buffer-substring-no-properties (point) (point-max)))) + (json-read-from-string json-string)))) + +(defun mastodon-client--token-file () + "Return `mastodon-client--token-file'." + mastodon-client--token-file) + +(defun mastodon-client--store () + "Store client_id and client_secret in `mastodon-client--token-file'. + +Make `mastodon-client--fetch' call to determine client values." + (let ((plstore (plstore-open (mastodon-client--token-file))) + (client (mastodon-client--fetch)) + ;; alexgriffith reported seeing ellipses in the saved output + ;; which indicate some output truncating. Nothing in `plstore-save' + ;; seems to ensure this cannot happen so let's do that ourselves: + (print-length nil) + (print-level nil)) + (plstore-put plstore (concat "mastodon-" mastodon-instance-url) client nil) + (plstore-save plstore) + (plstore-close plstore) + client)) + +(defun mastodon-client--read () + "Retrieve client_id and client_secret from `mastodon-client--token-file'." + (let* ((plstore (plstore-open (mastodon-client--token-file))) + (mastodon (plstore-get plstore (concat "mastodon-" mastodon-instance-url)))) + (cdr mastodon))) + +(defun mastodon-client () + "Return variable client secrets to use for the current `mastodon-instance-url'.. + +Read plist from `mastodon-client--token-file' if variable is nil. +Fetch and store plist if `mastodon-client--read' returns nil." + (let ((client-details + (cdr (assoc mastodon-instance-url mastodon-client--client-details-alist)))) + (unless client-details + (setq client-details + (or (mastodon-client--read) + (mastodon-client--store))) + (push (cons mastodon-instance-url client-details) + mastodon-client--client-details-alist)) + client-details)) + +(provide 'mastodon-client) +;;; mastodon-client.el ends here +
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-http.el @@ -0,0 +1,116 @@ +;;; mastodon-http.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Package-Requires: ((emacs "24.4")) +;; Homepage: https://github.com/jdenen/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-http.el provides HTTP request/response functions. + +;;; Code: + +(require 'json) +(defvar mastodon-instance-url) +(autoload 'mastodon-auth--access-token "mastodon-auth") + +(defvar mastodon-http--api-version "v1") + +(defun mastodon-http--api (endpoint) + "Return Mastondon API URL for ENDPOINT." + (concat mastodon-instance-url "/api/" + mastodon-http--api-version "/" endpoint)) + +(defun mastodon-http--response () + "Capture response buffer content as string." + (with-current-buffer (current-buffer) + (buffer-substring-no-properties (point-min) (point-max)))) + +(defun mastodon-http--response-body (pattern) + "Return substring matching PATTERN from `mastodon-http--response'." + (let ((resp (mastodon-http--response))) + (string-match pattern resp) + (match-string 0 resp))) + +(defun mastodon-http--status () + "Return HTTP Response Status Code from `mastodon-http--response'." + (let* ((status-line (mastodon-http--response-body "^HTTP/1.*$"))) + (string-match "[0-9][0-9][0-9]" status-line) + (match-string 0 status-line))) + +(defun mastodon-http--triage (response success) + "Determine if RESPONSE was successful. Call SUCCESS if successful. + +Open RESPONSE buffer if unsuccessful." + (let ((status (with-current-buffer response + (mastodon-http--status)))) + (if (string-prefix-p "2" status) + (funcall success) + (switch-to-buffer response)))) + +(defun mastodon-http--post (url args headers &optional unauthenticed-p) + "POST synchronously to URL with ARGS and HEADERS. + +Authorization header is included by default unless UNAUTHENTICED-P is non-nil." + (let ((url-request-method "POST") + (url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&"))) + (url-request-extra-headers + (append + (unless unauthenticed-p + `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) + headers))) + (with-temp-buffer + (url-retrieve-synchronously url)))) + +(defun mastodon-http--get (url) + "Make GET request to URL. + +Pass response buffer to CALLBACK function." + (let ((url-request-method "GET") + (url-request-extra-headers + `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))))) + (url-retrieve-synchronously url))) + +(defun mastodon-http--get-json (url) + "Make GET request to URL. Return JSON response vector." + (let ((json-vector + (with-current-buffer (mastodon-http--get url) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-string + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) + (kill-buffer) + (json-read-from-string json-string))))) + json-vector)) + +(provide 'mastodon-http) +;;; mastodon-http.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-inspect.el @@ -0,0 +1,91 @@ +;;; mastodon-inspect.el --- Client for Mastodon -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Package-Requires: ((emacs "24.4")) +;; Homepage: https://github.com/jdenen/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Some tools to help inspect / debug mastodon.el + +;;; Code: +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-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") + +(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 'toot-id)) + "*") + (mastodon-tl--property 'toot-json))) + +(defun mastodon-inspect--download-single-toot (toot-id) + "Download the toot/status represented by TOOT-ID." + (mastodon-http--get-json + (mastodon-http--api (concat "statuses/" toot-id)))) + +(defun mastodon-inspect--view-single-toot (toot-id) + "View the toot/status represented by TOOT-ID." + (interactive "s Toot ID: ") + (let ((buffer (get-buffer-create(concat "*mastodon-status-" toot-id "*")))) + (with-current-buffer buffer + (let ((toot (mastodon-inspect--download-single-toot toot-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 (toot-id) + "View the ess source of a toot/status represented by TOOT-ID." + (interactive "s Toot ID: ") + (mastodon-inspect--dump-json-in-buffer + (concat "*mastodon-status-raw-" toot-id "*") + (mastodon-inspect--download-single-toot toot-id))) + +(provide 'mastodon-inspect) +;;; mastodon-inspect.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-media.el @@ -0,0 +1,276 @@ +;;; mastodon-media.el --- Functions for inlining Mastodon media -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Homepage: https://github.com/jdenen/mastodon.el +;; Package-Requires: ((emacs "24.4")) + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-media.el provides functions for inlining media. + +;; Known bug gnutls -12 when trying to access images on some systems. +;; It looks like their may be a version mismatch between the encryption +;; required by the server and client. + +;;; Code: +(defvar url-show-status) + +(defgroup mastodon-media nil + "Inline Mastadon media." + :prefix "mastodon-media-" + :group 'mastodon) + +(defcustom mastodon-media--avatar-height 30 + "Height of the user avatar images (if shown)." + :group 'mastodon-media + :type 'integer) + +(defcustom mastodon-media--preview-max-height 250 + "Max height of any media attachment preview to be shown." + :group 'mastodon-media + :type 'integer) + +(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") + +(defun mastodon-media--process-image-response + (status-plist 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) ; only if the buffer hasn't been kill in the meantime + (let ((url-buffer (current-buffer)) + (is-error-response-p (eq :error (car status-plist)))) + (unwind-protect + (let* ((data (unless is-error-response-p + (goto-char (point-min)) + (search-forward "\n\n") + (buffer-substring (point) (point-max)))) + (image (when data + (apply #'create-image data (when image-options 'imagemagick) + t image-options)))) + (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. + (put-text-property marker (+ marker region-length) + 'display image)) + ;; We are done with the marker; release it: + (set-marker marker nil))) + (kill-buffer url-buffer))))))) + +(defun mastodon-media--load-image-from-url (url media-type start region-length) + "Takes a URL and MEDIA-TYPE and load the image asynchronously. + +MEDIA-TYPE is a symbol and either 'avatar or 'media-link." + ;; TODO: Cache the avatars + (let ((image-options (when (image-type-available-p 'imagemagick) + (cond + ((eq media-type 'avatar) + `(:height ,mastodon-media--avatar-height)) + ((eq media-type 'media-link) + `(:max-height ,mastodon-media--preview-max-height)))))) + (let ((buffer (current-buffer)) + (marker (copy-marker start)) + ;; Keep url.el from spamming us with messages about connecting to hosts: + (url-show-status nil)) + (condition-case nil + ;; catch any errors in url-retrieve so as to not abort + ;; whatever called us + (url-retrieve url + #'mastodon-media--process-image-response + (list marker image-options region-length)) + (error (with-current-buffer buffer + ;; TODO: Consider adding 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 + ;; Avatars are just one character in the buffer + ((eq media-type 'avatar) + (list next-pos (+ next-pos 1) 'avatar)) + ;; Media links are 5 character ("[img]") + ((eq media-type 'media-link) + (list next-pos (+ next-pos 5) 'media-link))))))) + +(defun mastodon-media--valid-link-p (link) + "Checks to make sure that 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 +replacing 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))) + (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)))))))) + +(defun mastodon-media--get-avatar-rendering (avatar-url) + "Returns 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 (image-type-available-p 'imagemagick) + `(: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 + (when image-options 'imagemagick) + t image-options)) + " "))) + +(defun mastodon-media--get-media-link-rendering (media-url) + "Returns the string to be written that renders the image at MEDIA-URL." + (concat + (propertize "[img]" + 'media-url media-url + 'media-state 'needs-loading + 'media-type 'media-link + 'display (create-image mastodon-media--generic-broken-image-data nil t)) + " ")) + +(provide 'mastodon-media) +;;; mastodon-media.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-notifications.el @@ -0,0 +1,149 @@ +;;; mastodon-notifications.el --- Notification functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.7.2 +;; Homepage: https://github.com/jdenen/mastodon.el +;; Package-Requires: ((emacs "24.4")) + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-notification.el provides notification functions for Mastodon. + +;;; Code: + +(autoload 'mastodon-media--inline-images "mastodon-media.el") +(autoload 'mastodon-tl--byline-author "mastodon-tl.el") +(autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl.el") +(autoload 'mastodon-tl--content "mastodon-tl.el") +(autoload 'mastodon-tl--field "mastodon-tl.el") +(autoload 'mastodon-tl--has-spoiler "mastodon-tl.el") +(autoload 'mastodon-tl--init "mastodon-tl.el") +(autoload 'mastodon-tl--insert-status "mastodon-tl.el") +(autoload 'mastodon-tl--spoiler "mastodon-tl.el") +(defvar mastodon-tl--display-media-p) + + +(defvar mastodon-notifications--types-alist + '(("mention" . mastodon-notifications--mention) + ("follow" . mastodon-notifications--follow) + ("favourite" . mastodon-notifications--favourite) + ("reblog" . mastodon-notifications--reblog)) + "Alist of notification types and their corresponding function.") + +(defvar mastodon-notifications--response-alist + '(("Mentioned" . "you") + ("Followed" . "you") + ("Favourited" . "your status") + ("Boosted" . "your status")) + "Alist of subjects for notification types.") + +(defun mastodon-notifications--byline-concat (message) + "Add byline for TOOT with MESSAGE." + (concat + " " + (propertize message 'face 'highlight) + " " + (cdr (assoc message mastodon-notifications--response-alist)))) + +(defun mastodon-notifications--mention (note) + "Format for a `mention' NOTE." + (let ((status (mastodon-tl--field 'status note))) + (mastodon-tl--insert-status + status + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (mastodon-tl--content status))) + 'mastodon-tl--byline-author + (lambda (_status) + (mastodon-notifications--byline-concat + "Mentioned"))))) + +(defun mastodon-notifications--follow (note) + "Format for a `follow' NOTE." + (mastodon-tl--insert-status + ;; Using reblog with an empty id will mark this as something + ;; non-boostable/non-favable. + (cons '(reblog (id . nil)) note) + (propertize "Congratulations, you have a new follower!" + 'face 'default) + 'mastodon-tl--byline-author + (lambda (_status) + (mastodon-notifications--byline-concat + "Followed")))) + +(defun mastodon-notifications--favourite (note) + "Format for a `favourite' NOTE." + (let ((status (mastodon-tl--field 'status note))) + (mastodon-tl--insert-status + status + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (mastodon-tl--content status))) + (lambda (_status) + (mastodon-tl--byline-author + note)) + (lambda (_status) + (mastodon-notifications--byline-concat + "Favourited"))))) + +(defun mastodon-notifications--reblog (note) + "Format for a `boost' NOTE." + (let ((status (mastodon-tl--field 'status note))) + (mastodon-tl--insert-status + status + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (mastodon-tl--content status))) + (lambda (_status) + (mastodon-tl--byline-author + note)) + (lambda (_status) + (mastodon-notifications--byline-concat + "Boosted"))))) + +(defun mastodon-notifications--by-type (note) + "Filters NOTE for those listed in `mastodon-notifications--types-alist'." + (let* ((type (mastodon-tl--field 'type note)) + (fun (cdr (assoc type mastodon-notifications--types-alist))) + (start-pos (point))) + (when fun + (funcall fun note) + (when mastodon-tl--display-media-p + (mastodon-media--inline-images start-pos (point)))))) + +(defun mastodon-notifications--timeline (json) + "Format JSON in Emacs buffer." + (mapc #'mastodon-notifications--by-type json) + (goto-char (point-min))) + +(defun mastodon-notifications--get () + "Display NOTIFICATIONS in buffer." + (interactive) + (mastodon-tl--init + "*mastodon-notifications*" + "notifications" + 'mastodon-notifications--timeline)) + +(provide 'mastodon-notifications) +;;; mastodon-notifications.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-pkg.el @@ -0,0 +1,10 @@ +(define-package "mastodon" "0.8.0" "Client for Mastodon" + '((emacs "24.4")) + :authors + '(("Johnson Denen" . "johnson.denen@gmail.com")) + :maintainer + '("Johnson Denen" . "johnson.denen@gmail.com") + :url "https://github.com/jdenen/mastodon.el") +;; Local Variables: +;; no-byte-compile: t +;; End:
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-profile.el @@ -0,0 +1,263 @@ +;;; mastodon-profile.el --- Functions for inspecting Mastodon profiles -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.7.2 +;; Package-Requires: ((emacs "24.4")) +;; Homepage: https://github.com/jdenen/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-profile.el generates a stream of users toots. +;; To add +;; - Option to follow +;; - wheather they follow you or not +;; - Show only Media + +;;; Code: +(require 'seq) + +(autoload 'mastodon-http--api "mastodon-http.el") +(autoload 'mastodon-http--get-json "mastodon-http.el") +(autoload 'mastodon-media--get-media-link-rendering "mastodon-media.el") +(autoload 'mastodon-media--inline-images "mastodon-media.el") +(autoload 'mastodon-mode "mastodon.el") +(autoload 'mastodon-tl--byline-author "mastodon-tl.el") +(autoload 'mastodon-tl--goto-next-toot "mastodon-tl.el") +(autoload 'mastodon-tl--property "mastodon-tl.el") +(autoload 'mastodon-tl--render-text "mastodon-tl.el") +(autoload 'mastodon-tl--set-face "mastodon-tl.el") +(autoload 'mastodon-tl--timeline "mastodon-tl.el") +(autoload 'mastodon-tl--toot-id "mastodon-tl") + +(defvar mastodon-instance-url) +(defvar mastodon-tl--buffer-spec) +(defvar mastodon-tl--update-point) + +(defvar mastodon-profile--account nil + "The data for the account being described in the current profile buffer.") +(make-variable-buffer-local 'mastodon-profile--account) + +(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 + ;; The mode line indicator. + :lighter " Profile" + ;; The key bindings + :keymap '(((kbd "F") . mastodon-profile--open-followers) + ((kbd "f") . mastodon-profile--open-following)) + :group 'mastodon) + +(defun mastodon-profile--toot-json () + "Get the next toot-json." + (interactive) + (mastodon-tl--property 'toot-json)) + +(defun mastodon-profile--make-author-buffer (account) + "Take a ACCOUNT and inserts a user account into a new buffer." + (mastodon-profile--make-profile-buffer-for + account "statuses" #'mastodon-tl--timeline)) + +(defun mastodon-profile--open-following () + "Open a profile buffer for the current profile showing the accounts +that current profile follows." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-profile-buffer-for + mastodon-profile--account + "following" + #'mastodon-profile--add-author-bylines) + (error "Not in a mastodon profile"))) + +(defun mastodon-profile--open-followers () + "Open a profile buffer for the current profile showing the accounts +following the current profile." + (interactive) + (if mastodon-profile--account + (mastodon-profile--make-profile-buffer-for + mastodon-profile--account + "followers" + #'mastodon-profile--add-author-bylines) + (error "Not in a mastodon profile"))) + +(defun mastodon-profile--make-profile-buffer-for (account endpoint-type update-function) + (let* ((id (mastodon-profile--account-field account 'id)) + (acct (mastodon-profile--account-field account 'acct)) + (url (mastodon-http--api (format "accounts/%s/%s" + id endpoint-type))) + (buffer (concat "*mastodon-" acct "-" endpoint-type "*")) + (note (mastodon-profile--account-field account 'note)) + (json (mastodon-http--get-json url))) + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + (mastodon-mode) + (mastodon-profile-mode) + (setq mastodon-profile--account account + mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,(format "accounts/%s/%s" id endpoint-type) + update-function ,update-function)) + (let* ((inhibit-read-only t) + (is-statuses (string= endpoint-type "statuses")) + (is-followers (string= endpoint-type "followers")) + (is-following (string= endpoint-type "following")) + (endpoint-name (cond + (is-statuses " TOOTS ") + (is-followers " FOLLOWERS ") + (is-following " FOLLOWING ")))) + (insert + "\n" + (mastodon-profile--image-from-account account) + "\n" + (propertize (mastodon-profile--account-field + account 'display_name) + 'face 'mastodon-display-name-face) + "\n" + (propertize acct + 'face 'default) + "\n ------------\n" + (mastodon-tl--render-text note nil) + (mastodon-tl--set-face + (concat " ------------\n" + endpoint-name "\n" + " ------------\n") + 'success)) + (setq mastodon-tl--update-point (point)) + (mastodon-media--inline-images (point-min) (point)) + (funcall update-function json))) + (mastodon-tl--goto-next-toot))) + +(defun mastodon-profile--get-toot-author () + "Opens authors profile of toot under point." + (interactive) + (mastodon-profile--make-author-buffer + (cdr (assoc 'account (mastodon-profile--toot-json))))) + +(defun mastodon-profile--image-from-account (status) + "Generate an image from a STATUS." + (let ((url (cdr (assoc 'avatar_static status)))) + (unless (equal url "/avatars/original/missing.png") + (mastodon-media--get-media-link-rendering url)))) + +(defun mastodon-profile--show-user (user-handle) + "Query user for user id from current status and show that user's profile." + (interactive + (list + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read "User handle: " + user-handles + nil ; predicate + 'confirm)))) + (let ((account (mastodon-profile--lookup-account-in-status + user-handle (mastodon-profile--toot-json)))) + (if account + (mastodon-profile--make-author-buffer account) + (message "Cannot find a user with handle %S" user-handle)))) + +(defun mastodon-profile--account-field (account field) + "Return FIELD from the ACCOUNT. + +FIELD is used to identify regions under 'account" + (cdr (assoc field account))) + +(defun mastodon-profile--add-author-bylines (tootv) + "Convert TOOTV into a author-bylines and insert." + (let ((inhibit-read-only t)) + (mapc (lambda (toot) + (let ((start-pos (point))) + (insert "\n" + (propertize + (mastodon-tl--byline-author `((account . ,toot))) + 'byline 't + 'toot-id (cdr (assoc 'id toot)) + 'base-toot-id (mastodon-tl--toot-id toot) + 'toot-json toot)) + (mastodon-media--inline-images start-pos (point)) + (insert "\n" + (mastodon-tl--render-text (cdr (assoc 'note toot)) nil) + "\n"))) + tootv))) + +(defun mastodon-profile--search-account-by-handle (handle) + "Return an account based on a users 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)) + (matching-account + (seq-remove + (lambda(x) (not (string= (cdr (assoc 'acct x)) handle))) + (mastodon-http--get-json + (mastodon-http--api (format "accounts/search?q=%s" handle)))))) + (when (equal 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 from Mastodon." + (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 (cdr (assoc 'account status))) + (mentions (cdr (assoc 'mentions status))) + (reblog (cdr (assoc 'reblog status)))) + (seq-filter + 'stringp + (seq-uniq + (seq-concatenate + 'list + (list (cdr (assoc 'acct this-account))) + (mastodon-profile--extract-users-handles reblog) + (mapcar (lambda (mention) + (cdr (assoc 'acct mention))) + mentions))))))) + +(defun mastodon-profile--lookup-account-in-status (handle status) + "Return account for HANDLE using hints in STATUS if possible." + (let* ((this-account (cdr (assoc 'account status))) + (reblog-account (cdr (assoc 'account (cdr (assoc 'reblog status))))) + (mention-id (seq-some + (lambda (mention) + (when (string= handle + (cdr (assoc 'acct mention))) + (cdr (assoc 'id mention)))) + (cdr (assoc 'mentions status))))) + (cond ((string= handle + (cdr (assoc 'acct this-account))) + this-account) + ((string= handle + (cdr (assoc 'acct reblog-account))) + reblog-account) + (mention-id + (mastodon-profile--account-from-id mention-id)) + (t + (mastodon-profile--search-account-by-handle handle))))) + +(provide 'mastodon-profile) +;;; mastodon-profile.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-tl.el @@ -0,0 +1,984 @@ +;;; mastodon-tl.el --- HTTP request/response functions for mastodon.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Homepage: https://github.com/jdenen/mastodon.el +;; Package-Requires: ((emacs "24.4")) + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-tl.el provides timeline functions. + +;;; Code: + +(require 'shr) +(require 'thingatpt) ;; for word-at-point +(require 'time-date) + +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-media--get-avatar-rendering "mastodon-media") +(autoload 'mastodon-media--get-media-link-rendering "mastodon-media") +(autoload 'mastodon-media--inline-images "mastodon-media") +(autoload 'mastodon-mode "mastodon") +(autoload 'mastodon-profile--account-from-id "mastodon.el-profile.el") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile.el") +(autoload 'mastodon-profile--search-account-by-handle "mastodon.el-profile.el") +(defvar mastodon-instance-url) +(defvar mastodon-toot-timestamp-format) +(defvar shr-use-fonts) ;; need to declare it since Emacs24 didn't have this + +(defgroup mastodon-tl nil + "Timelines in Mastodon." + :prefix "mastodon-tl-" + :group 'mastodon) + +(defcustom mastodon-tl--enable-relative-timestamps t + "Nonnil to enable showing relative (to the current time) timestamps. + +This will require periodic updates of a timeline buffer to +keep the timestamps current as time progresses." + :group 'mastodon-tl + :type '(boolean :tag "Enable relative timestamps and background updater task")) + +(defcustom mastodon-tl--enable-proportional-fonts nil + "Nonnil to enable using proportional fonts when rendering HTML. + +By default fixed width fonts are used." + :group 'mastodon-tl + :type '(boolean :tag "Enable using proportional rather than fixed \ +width fonts when rendering HTML text")) + +(defvar mastodon-tl--buffer-spec nil + "A unique identifier and functions for each Mastodon buffer.") +(make-variable-buffer-local 'mastodon-tl--buffer-spec) + +(defvar mastodon-tl--show-avatars-p + (image-type-available-p 'imagemagick) + "A boolean value stating whether to show avatars in timelines.") + +(defvar 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.") +(make-variable-buffer-local 'mastodon-tl--update-point) + +(defvar mastodon-tl--display-media-p t + "A boolean value stating whether to show media in timelines.") + +(defvar mastodon-tl--timestamp-next-update nil + "The timestamp when the buffer should next be scanned to update the timestamps.") +(make-variable-buffer-local 'mastodon-tl--timestamp-next-update) + +(defvar mastodon-tl--timestamp-update-timer nil + "The timer that, when set will scan the buffer to update the timestamps.") +(make-variable-buffer-local 'mastodon-tl--timestamp-update-timer) + +(defvar mastodon-tl--link-keymap + (let ((map (make-sparse-keymap))) + (define-key map [return] 'mastodon-tl--do-link-action-at-point) + (define-key map [mouse-2] 'mastodon-tl--do-link-action) + (define-key map [follow-link] 'mouse-face) + (keymap-canonicalize map)) + "The keymap set for things in the buffer that act like links (except for shr.el generate links). + +This will make the region of text act like like a link with mouse +highlighting, mouse click action tabbing to next/previous link +etc.") + +(defvar mastodon-tl--shr-map-replacement + (let ((map (copy-keymap shr-map))) + ;; 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) + (keymap-canonicalize map)) + "The keymap to be set for shr.el generated links that are not images. + +We need to override the keymap so tabbing will navigate to all +types of mastodon links and not just shr.el-generated ones.") + +(defvar mastodon-tl--shr-image-map-replacement + (let ((map (copy-keymap (if (boundp 'shr-image-map) + shr-image-map + shr-map)))) + ;; 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) + (keymap-canonicalize 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.") + +(defun mastodon-tl--next-tab-item () + "Move to the next interesting item. + +This could be the next toot, link, or image; whichever comes first. +Don't move if nothing else 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." + (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 nil)) + + (get-text-property (car next-range) 'invisible) + (setq search-pos (1+ (cdr next-range)))) + ;; do nothing, all the action in in the while condition + ) + (if (null next-range) + (message "Nothing else here.") + (goto-char (car next-range)) + (message "%s" (get-text-property (point) 'help-echo))))) + +(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) + (let (next-range + (search-pos (point))) + (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range + 'mastodon-tab-stop search-pos t)) + (get-text-property (car next-range) 'invisible) + (setq search-pos (1- (car next-range)))) + ;; do nothing, all the action in in the while condition + ) + (if (null next-range) + (message "Nothing else before this.") + (goto-char (car next-range)) + (message "%s" (get-text-property (point) 'help-echo))))) + +(defun mastodon-tl--get-federated-timeline () + "Opens federated timeline." + (interactive) + (mastodon-tl--init + "federated" "timelines/public" 'mastodon-tl--timeline)) + +(defun mastodon-tl--get-home-timeline () + "Opens home timeline." + (interactive) + (mastodon-tl--init + "home" "timelines/home" 'mastodon-tl--timeline)) + +(defun mastodon-tl--get-local-timeline () + "Opens local timeline." + (interactive) + (mastodon-tl--init + "local" "timelines/public?local=true" 'mastodon-tl--timeline)) + +(defun mastodon-tl--get-tag-timeline () + "Prompts for tag and opens its timeline." + (interactive) + (let* ((word (or (word-at-point) "")) + (input (read-string (format "Tag(%s): " word))) + (tag (if (equal input "") word input))) + (mastodon-tl--show-tag-timeline tag))) + +(defun mastodon-tl--show-tag-timeline (tag) + "Opens a new buffer showing the timeline of posts with hastag TAG." + (mastodon-tl--init + (concat "tag-" tag) (concat "timelines/tag/" tag) 'mastodon-tl--timeline)) + +(defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) + "Search for toot with FIND-POS. +If search returns nil, execute REFRESH function. + +Optionally start from POS." + (let* ((npos (funcall find-pos + (or pos (point)) + 'byline + (current-buffer)))) + (if npos + (if (not (get-text-property npos 'toot-id)) + (mastodon-tl--goto-toot-pos find-pos refresh npos) + (goto-char npos)) + (funcall refresh)))) + +(defun mastodon-tl--goto-next-toot () + "Jump to next toot header." + (interactive) + (mastodon-tl--goto-toot-pos 'next-single-property-change + 'mastodon-tl--more)) + +(defun mastodon-tl--goto-prev-toot () + "Jump to last toot header." + (interactive) + (mastodon-tl--goto-toot-pos 'previous-single-property-change + 'mastodon-tl--update)) + +(defun mastodon-tl--remove-html (toot) + "Remove unrendered tags from TOOT." + (let* ((t1 (replace-regexp-in-string "<\/p>" "\n\n" toot)) + (t2 (replace-regexp-in-string "<\/?span>" "" t1))) + (replace-regexp-in-string "<span class=\"h-card\">" "" t2))) + +(defun mastodon-tl--byline-author (toot) + "Propertize author of TOOT." + (let* ((account (cdr (assoc 'account toot))) + (handle (cdr (assoc 'acct account))) + (name (cdr (assoc 'display_name account))) + (profile-url (cdr (assoc 'url account))) + (avatar-url (cdr (assoc 'avatar account)))) + ;; TODO: Once we have a view for a user (e.g. their posts + ;; timeline) make this a tab-stop and attach an action + (concat + (when (and mastodon-tl--show-avatars-p mastodon-tl--display-media-p) + (mastodon-media--get-avatar-rendering avatar-url)) + (propertize name 'face 'mastodon-display-name-face) + " (" + (propertize (concat "@" handle) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + ;; TODO: Replace url browsing with native profile viewing + 'mastodon-tab-stop 'user-handle + 'account account + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" handle) + 'help-echo (concat "Browse user profile of @" handle)) + ")"))) + +(defun mastodon-tl--byline-boosted (toot) + "Add byline for boosted data from TOOT." + (let ((reblog (cdr (assoc 'reblog toot)))) + (when reblog + (concat + " " + (propertize "Boosted" 'face 'mastodon-boosted-face) + " " + (mastodon-tl--byline-author reblog))))) + +(defun mastodon-tl--field (field toot) + "Return FIELD from TOOT. + +Return value from boosted content if available." + (or (cdr (assoc field (cdr (assoc 'reblog toot)))) + (cdr (assoc field toot)))) + +(defun mastodon-tl--relative-time-details (timestamp &optional current-time) + "Returns cons of (descriptive string . next change) for the TIMESTAMP. + +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). + +The descriptive string is a human readable version relative to +the current time while the next change timestamp give the first +time that this description will change in the future. + +TIMESTAMP is assumed to be in the past." + (let* ((now (or current-time (current-time))) + (time-difference (time-subtract now timestamp)) + (seconds-difference (float-time time-difference)) + (regular-response + (lambda (seconds-difference multiplier unit-name) + (let ((n (floor (+ 0.5 (/ seconds-difference multiplier))))) + (cons (format "%d %ss ago" n unit-name) + (* (+ 0.5 n) multiplier))))) + (relative-result + (cond + ((< seconds-difference 60) + (cons "less than a minute ago" + 60)) + ((< seconds-difference (* 1.5 60)) + (cons "one minute ago" + 90)) ;; at 90 secs + ((< seconds-difference (* 60 59.5)) + (funcall regular-response seconds-difference 60 "minute")) + ((< seconds-difference (* 1.5 60 60)) + (cons "one hour ago" + (* 60 90))) ;; at 90 minutes + ((< seconds-difference (* 60 60 23.5)) + (funcall regular-response seconds-difference (* 60 60) "hour")) + ((< seconds-difference (* 1.5 60 60 24)) + (cons "one day ago" + (* 1.5 60 60 24))) ;; at a day and a half + ((< seconds-difference (* 60 60 24 6.5)) + (funcall regular-response seconds-difference (* 60 60 24) "day")) + ((< seconds-difference (* 1.5 60 60 24 7)) + (cons "one week ago" + (* 1.5 60 60 24 7))) ;; a week and a half + ((< seconds-difference (* 60 60 24 7 52)) + (if (= 52 (floor (+ 0.5 (/ seconds-difference 60 60 24 7)))) + (cons "52 weeks ago" + (* 60 60 24 7 52)) + (funcall regular-response seconds-difference (* 60 60 24 7) "week"))) + ((< seconds-difference (* 1.5 60 60 24 365)) + (cons "one year ago" + (* 60 60 24 365 1.5))) ;; a year and a half + (t + (funcall regular-response seconds-difference (* 60 60 24 365.25) "year"))))) + (cons (car relative-result) + (time-add timestamp (seconds-to-time (cdr relative-result)))))) + +(defun mastodon-tl--relative-time-description (timestamp &optional current-time) + "Returns a string with a human readable description of TIMESTMAP relative to the current time. + +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). + +E.g. this could return something like \"1 min ago\", \"yesterday\", etc. +TIME-STAMP is assumed to be in the past." + (car (mastodon-tl--relative-time-details timestamp current-time))) + +(defun mastodon-tl--byline (toot author-byline action-byline) + "Generate byline for TOOT. + +AUTHOR-BYLINE is function for adding the author portion of +the byline that takes one variable. +ACTION-BYLINE is a function for adding an action, such as boosting +favouriting and following to the byline. It also takes a single function. By default +it is `mastodon-tl--byline-boosted'" + (let ((parsed-time (date-to-time (mastodon-tl--field 'created_at toot))) + (faved (equal 't (mastodon-tl--field 'favourited toot))) + (boosted (equal 't (mastodon-tl--field 'reblogged toot)))) + (concat + (propertize "\n | " 'face 'default) + (propertize + (concat (when boosted + (format "(%s) " + (propertize "B" 'face 'mastodon-boost-fave-face))) + (when faved + (format "(%s) " + (propertize "F" 'face 'mastodon-boost-fave-face))) + (funcall author-byline toot) + (funcall action-byline toot) + " " + ;; TODO: Once we have a view for toot (responses etc.) make + ;; this a tab stop and attach an action. + (propertize + (format-time-string mastodon-toot-timestamp-format parsed-time) + 'timestamp parsed-time + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description parsed-time) + parsed-time)) + (propertize "\n ------------" 'face 'default)) + 'favourited-p faved + 'boosted-p boosted + 'byline t)))) + +(defun mastodon-tl--render-text (string toot) + "Returns a propertized text giving the rendering of 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." + (with-temp-buffer + (insert string) + (let ((shr-use-fonts mastodon-tl--enable-proportional-fonts) + (shr-width (when mastodon-tl--enable-proportional-fonts + (window-width)))) + (shr-render-region (point-min) (point-max))) + ;; Make all links a tab stop recognized by our own logic, make things point + ;; to our own logic (e.g. hashtags), and update keymaps where needed: + (when toot + (let (region) + (while (setq region (mastodon-tl--find-property-range + 'shr-url (or (cdr region) (point-min)))) + (mastodon-tl--process-link toot + (car region) (cdr region) + (get-text-property (car region) 'shr-url))))) + (buffer-string))) + +(defun mastodon-tl--process-link (toot start end url) + (let* (mastodon-tab-stop-type + keymap + (help-echo (get-text-property start 'help-echo)) + extra-properties + (toot-url (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)) + (maybe-hashtag (mastodon-tl--extract-hashtag-from-url + url toot-instance-url)) + (maybe-userhandle (mastodon-tl--extract-userhandle-from-url + url (buffer-substring-no-properties start end)))) + (cond (;; Hashtags: + 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))) + + (;; User handles: + maybe-userhandle + (let ((maybe-userid (mastodon-tl--extract-userid-toot + toot maybe-userhandle))) + (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 'acccount-id maybe-userid)))))) + ;; Anything else: + (t + ;; Leave it as a url handled by shr.el. + ;; (We still have to replace the keymap so that tabbing works.) + (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--extract-userid-toot (toot acct) + "Extract a user id for an ACCT from mentions in a TOOT." + (let* ((mentions (append (cdr (assoc 'mentions toot)) nil)) + (mention (pop mentions)) + (short-acct (substring acct 1 (length acct))) + return) + (while mention + (when (string= (cdr (assoc 'acct mention)) + short-acct) + (setq return (cdr (assoc 'id mention)))) + (setq mention (pop mentions))) + return)) + +(defun mastodon-tl--extract-userhandle-from-url (url buffer-text) + "Returns the user hande the URL points to or nil if it is not a profile link. + +BUFFER-TEXT is the text covered by the link with URL, for a user profile +this should be of the form <at-sign><user id>, e.g. \"@Gargon\"." + (let ((parsed-url (url-generic-parse-url url))) + (when (and (string= "@" (substring buffer-text 0 1)) + (string= (downcase buffer-text) + (downcase (substring (url-filename parsed-url) 1)))) + (concat buffer-text "@" (url-host parsed-url))))) + +(defun mastodon-tl--extract-hashtag-from-url (url instance-url) + "Returns 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)." + (cond + ;; Mastodon type tag link: + ((string-prefix-p (concat instance-url "/tags/") url) + (substring url (length (concat instance-url "/tags/")))) + ;; Link from some other ostatus site we've encountered: + ((string-prefix-p (concat instance-url "/tag/") url) + (substring url (length (concat instance-url "/tag/")))) + ;; If nothing matches we assume it is not a hashtag link: + (t nil))) + +(defun mastodon-tl--set-face (string face) + "Returns the propertized STRING with the face property set to FACE." + (propertize string 'face face)) + +(defun mastodon-tl--toggle-spoiler-text (position) + "Toggle the visibility of the spoiler text at/after POSITION." + (let ((inhibit-read-only t) + (spoiler-text-region (mastodon-tl--find-property-range + 'mastodon-content-warning-body position nil))) + (if (not spoiler-text-region) + (message "No spoiler text here") + (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) + (list 'invisible + (not (get-text-property (car spoiler-text-region) + 'invisible))))))) + +(defun mastodon-tl--toggle-spoiler-text-in-toot () + "Toggle the visibility of the spoiler text in the current toot." + (interactive) + (let* ((toot-range (or (mastodon-tl--find-property-range + 'toot-json (point)) + (mastodon-tl--find-property-range + 'toot-json (point) t))) + (spoiler-range (when toot-range + (mastodon-tl--find-property-range + 'mastodon-content-warning-body + (car toot-range))))) + (cond ((null toot-range) + (message "No toot here")) + ((or (null spoiler-range) + (> (car spoiler-range) (cdr toot-range))) + (message "No content warning text here")) + (t + (mastodon-tl--toggle-spoiler-text (car spoiler-range)))))) + +(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") + (t + (error "unknown link type %s" link-type))))) + (propertize + string + 'mastodon-tab-stop link-type + 'mouse-face 'highlight + 'keymap mastodon-tl--link-keymap + 'help-echo help-text))) + +(defun mastodon-tl--do-link-action-at-point (position) + (interactive "d") + (let ((link-type (get-text-property position 'mastodon-tab-stop))) + (cond ((eq link-type 'content-warning) + (mastodon-tl--toggle-spoiler-text position)) + ((eq link-type 'hashtag) + (mastodon-tl--show-tag-timeline (get-text-property position 'mastodon-tag))) + ((eq link-type 'user-handle) + (let ((account-json (get-text-property position 'account)) + (account-id (get-text-property position '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 + (mastodon-profile--make-author-buffer + (mastodon-profile--search-account-by-handle + (get-text-property position 'mastodon-handle))))))) + (t + (error "unknown link type %s" link-type))))) + +(defun mastodon-tl--do-link-action (event) + (interactive "e") + (mastodon-tl--do-link-action-at-point (posn-point (event-end event)))) + +(defun mastodon-tl--has-spoiler (toot) + "Check if the given TOOT has a spoiler text that 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--clean-tabs-and-nl (string) + (replace-regexp-in-string + "[\t\n ]*\\'" "" string)) + +(defun mastodon-tl--spoiler (toot) + "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." + (let* ((spoiler (mastodon-tl--field 'spoiler_text toot)) + (string (mastodon-tl--set-face + ;; remove trailing whitespace + (mastodon-tl--clean-tabs-and-nl + (mastodon-tl--render-text spoiler toot)) + 'default)) + (message (concat "\n" + " ---------------\n" + " " (mastodon-tl--make-link "Content Warning" + 'content-warning) + "\n" + " ---------------\n")) + (cw (mastodon-tl--set-face message 'mastodon-cw-face))) + (concat + string + cw + (propertize (mastodon-tl--content toot) + 'invisible t + 'mastodon-content-warning-body t)))) + +(defun mastodon-tl--media (toot) + "Retrieve a media attachment link for TOOT if one exists." + (let* ((media-attachements (mastodon-tl--field 'media_attachments toot)) + (media-string (mapconcat + (lambda (media-attachement) + (let ((preview-url + (cdr (assoc 'preview_url media-attachement)))) + (if mastodon-tl--display-media-p + (mastodon-media--get-media-link-rendering + preview-url) + (concat "Media::" preview-url "\n")))) + media-attachements ""))) + (if (not (and mastodon-tl--display-media-p + (equal media-string ""))) + (concat "\n" media-string) + ""))) + + +(defun mastodon-tl--content (toot) + "Retrieve text content from TOOT." + (let ((content (mastodon-tl--field 'content toot))) + (concat + (mastodon-tl--render-text content toot) + (mastodon-tl--media toot)))) + +(defun mastodon-tl--insert-status (toot body author-byline action-byline) + "Display the content and byline of a timeline element. + +BODY will form the section of the toot above the byline. +AUTHOR-BYLINE is an optional function for adding the author portion of +the byline that takes one variable. By default it is `mastodon-tl--byline-author' +ACTION-BYLINE is also an optional function for adding an action, such as boosting +favouriting and following to the byline. It also takes a single function. By default +it is `mastodon-tl--byline-boosted'" + (let ((start-pos (point))) + (insert + (propertize + (concat body + (mastodon-tl--byline toot author-byline action-byline)) + 'toot-id (cdr (assoc 'id toot)) + 'base-toot-id (mastodon-tl--toot-id toot) + 'toot-json toot) + "\n\n") + (when mastodon-tl--display-media-p + (mastodon-media--inline-images start-pos (point))))) + +(defun mastodon-tl--toot(toot) + "Formats TOOT and insertes it into the buffer." + (mastodon-tl--insert-status + toot + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler toot) + (mastodon-tl--spoiler toot) + (mastodon-tl--content toot))) + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + +(defun mastodon-tl--timeline (toots) + "Display each toot in TOOTS." + (mapc 'mastodon-tl--toot toots) + (goto-char (point-min))) + +(defun mastodon-tl--get-update-function (&optional buffer) + "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'" + (mastodon-tl--get-buffer-property 'update-function buffer)) + +(defun mastodon-tl--get-endpoint (&optional buffer) + "Get the ENDPOINT stored in `mastodon-tl--buffer-spec'" + (mastodon-tl--get-buffer-property 'endpoint buffer)) + +(defun mastodon-tl--buffer-name (&optional buffer) + "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'" + (mastodon-tl--get-buffer-property 'buffer-name buffer )) + +(defun mastodon-tl--get-buffer-property (property &optional buffer) + "Get `MASTODON-TL--BUFFER-SPEC' in BUFFER or `CURRENT-BUFFER'" + (with-current-buffer (or buffer (current-buffer)) + (if (plist-get mastodon-tl--buffer-spec property) + (plist-get mastodon-tl--buffer-spec property) + (error "mastodon-tl--buffer-spec is not defined for buffer %s" + (or buffer (current-buffer)))))) + +(defun mastodon-tl--more-json (endpoint id) + "Return JSON for timeline ENDPOINT before ID." + (let* ((url (mastodon-http--api (concat + endpoint + (if (string-match-p "?" endpoint) + "&" + "?") + "max_id=" + (mastodon-tl--as-string id))))) + (mastodon-http--get-json url))) + +;; TODO +;; Look into the JSON returned here by Local +(defun mastodon-tl--updated-json (endpoint id) + "Return JSON for timeline ENDPOINT since ID." + (let ((url (mastodon-http--api (concat + endpoint + (if (string-match-p "?" endpoint) + "&" + "?") + "since_id=" + (mastodon-tl--as-string id))))) + (mastodon-http--get-json url))) + +(defun mastodon-tl--property (prop &optional backward) + "Get property PROP for toot at point. + +Move forward (down) the timeline unless BACKWARD is non-nil." + (or (get-text-property (point) prop) + (save-excursion + (if backward + (mastodon-tl--goto-prev-toot) + (mastodon-tl--goto-next-toot)) + (get-text-property (point) prop)))) + +(defun mastodon-tl--newest-id () + "Return toot-id from the top of the buffer." + (save-excursion + (goto-char (point-min)) + (mastodon-tl--property 'toot-id))) + +(defun mastodon-tl--oldest-id () + "Return toot-id from the bottom of the buffer." + (save-excursion + (goto-char (point-max)) + (mastodon-tl--property 'toot-id t))) + +(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--toot-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 ((id (cdr (assoc 'id json))) + (reblog (cdr (assoc 'reblog json)))) + (if reblog (cdr (assoc 'id reblog)) id))) + +(defun mastodon-tl--thread () + "Open thread buffer for toot under `point'." + (interactive) + (let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id + (mastodon-tl--property 'toot-json)))) + (url (mastodon-http--api (format "statuses/%s/context" id))) + (buffer (format "*mastodon-thread-%s*" id)) + (toot (mastodon-tl--property 'toot-json)) + (context (mastodon-http--get-json url))) + (when (member (cdr (assoc 'type toot)) '("reblog" "favourite")) + (setq toot (cdr (assoc 'status toot)))) + (if (> (+ (length (cdr (assoc 'ancestors context))) + (length (cdr (assoc 'descendants context)))) + 0) + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + (mastodon-mode) + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,(format "statuses/%s/context" id) + update-function + (lambda(toot) (message "END of thread.")))) + (let ((inhibit-read-only t)) + (mastodon-tl--timeline (vconcat + (cdr (assoc 'ancestors context)) + `(,toot) + (cdr (assoc 'descendants context)))))) + (message "No Thread!")))) + +(defun mastodon-tl--more () + "Append older toots to timeline." + (interactive) + (let* ((point-before (point)) + (endpoint (mastodon-tl--get-endpoint)) + (update-function (mastodon-tl--get-update-function)) + (id (mastodon-tl--oldest-id)) + (json (mastodon-tl--more-json endpoint id))) + (when json + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (funcall update-function json) + (goto-char point-before))))) + +(defun mastodon-tl--find-property-range (property start-point &optional search-backwards) + " Returns `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 (equal 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 (equal 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 (equal 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) + "Finds (start . end) range after/before START-POINT where PROPERTY is set to a consistent value (different from the value at START-POINT if that is set). + +Returns nil if no such range exists. + +If SEARCH-BACKWARDS is non-nil it find a region before +START-POINT otherwise after START-POINT. +" + (if (get-text-property start-point property) + ;; 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 (equal (car current-range) (point-min)) + (mastodon-tl--find-property-range + property (1- (car current-range)) search-backwards)) + (unless (equal (cdr current-range) (point-max)) + (mastodon-tl--find-property-range + property (1+ (cdr current-range)) search-backwards)))) + ;; 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))) + +(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 (`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 this-update + 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 ;; should be true but 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 + ;; This is 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 mastodon-tl--timestamp-next-update + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + buffer nil)))))))) + +(defun mastodon-tl--update () + "Update timeline with new toots." + (interactive) + (let* ((endpoint (mastodon-tl--get-endpoint)) + (update-function (mastodon-tl--get-update-function)) + (id (mastodon-tl--newest-id)) + (json (mastodon-tl--updated-json endpoint id))) + (when json + (let ((inhibit-read-only t)) + (goto-char (or mastodon-tl--update-point (point-min))) + (funcall update-function json))))) + +(defun mastodon-tl--init (buffer-name endpoint update-function) + "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. + +UPDATE-FUNCTION is used to recieve more toots." + (let* ((url (mastodon-http--api endpoint)) + (buffer (concat "*mastodon-" buffer-name "*")) + (json (mastodon-http--get-json url))) + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + (setq + ;; Initialize with a minimal interval; we re-scan at least once + ;; every 5 minutes to catch any timestamps we may have missed + mastodon-tl--timestamp-next-update (time-add (current-time) + (seconds-to-time 300))) + (funcall update-function json)) + (mastodon-mode) + (with-current-buffer buffer + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer-name + endpoint ,endpoint update-function + ,update-function) + mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time mastodon-tl--timestamp-next-update + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil)))) + buffer)) + +(provide 'mastodon-tl) +;;; mastodon-tl.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon-toot.el @@ -0,0 +1,296 @@ +;;; mastodon-toot.el --- Minor mode for sending Mastodon toots -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Homepage: https://github.com/jdenen/mastodon.el +;; Package-Requires: ((emacs "24.4")) + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon-toot.el supports POSTing status data to Mastodon. + +;;; Code: + +(defvar mastodon-instance-url) +(defvar mastodon-toot--content-warning nil) + +(autoload 'mastodon-auth--user-acct "mastodon-auth") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-tl--as-string "mastodon-tl") +(autoload 'mastodon-tl--field "mastodon-tl") +(autoload 'mastodon-tl--goto-next-toot "mastodon-tl") +(autoload 'mastodon-tl--property "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-toot "mastodon") + +(defvar mastodon-toot--reply-to-id nil + "Buffer-local variable to hold the id of the toot being replied to.") +(make-variable-buffer-local 'mastodon-toot--reply-to-id) + +(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--toggle-warning) + map) + "Keymap for `mastodon-toot'.") + +(defun mastodon-toot--action-success (marker byline-region remove) + "Insert/remove the text MARKER with 'success face in byline. + +BYLINE-REGION is a cons of start and end pos of the byline to be +modified. +Remove MARKER if REMOVE is non-nil, otherwise add it." + (let ((inhibit-read-only t) + (bol (car byline-region)) + (eol (cdr byline-region))) + (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 t) + (replace-match "") + (message "Oops: could not find marker '(%s)'" marker))) + (unless remove + (goto-char bol) + (insert (format "(%s) " + (propertize marker 'face 'success))))))) + +(defun mastodon-toot--action (action callback) + "Take ACTION on toot at point, then execute CALLBACK." + (let* ((id (mastodon-tl--property 'base-toot-id)) + (url (mastodon-http--api (concat "statuses/" + (mastodon-tl--as-string id) + "/" + action)))) + (let ((response (mastodon-http--post url nil nil))) + (mastodon-http--triage response callback)))) + +(defun mastodon-toot--toggle-boost () + "Boost/unboost toot at `point'." + (interactive) + (let* ((has-id (mastodon-tl--property 'base-toot-id)) + (byline-region (when has-id + (mastodon-tl--find-property-range 'byline (point)))) + (id (when byline-region + (mastodon-tl--as-string (mastodon-tl--property 'base-toot-id)))) + (boosted (when byline-region + (get-text-property (car byline-region) 'boosted-p))) + (action (if boosted "unreblog" "reblog")) + (msg (if boosted "unboosted" "boosted")) + (remove (when boosted t))) + (if byline-region + (mastodon-toot--action action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'boosted-p + (not boosted))) + (mastodon-toot--action-success + "B" byline-region remove)) + (message (format "%s #%s" msg id)))) + (message "Nothing to boost here?!?")))) + +(defun mastodon-toot--toggle-favourite () + "Favourite/unfavourite toot at `point'." + (interactive) + (let* ((has-id (mastodon-tl--property 'base-toot-id)) + (byline-region (when has-id + (mastodon-tl--find-property-range 'byline (point)))) + (id (when byline-region + (mastodon-tl--as-string (mastodon-tl--property 'base-toot-id)))) + (faved (when byline-region + (get-text-property (car byline-region) 'favourited-p))) + (action (if faved "unfavourite" "favourite")) + (remove (when faved t))) + (if byline-region + (mastodon-toot--action action + (lambda () + (let ((inhibit-read-only t)) + (add-text-properties (car byline-region) + (cdr byline-region) + (list 'favourited-p + (not faved))) + (mastodon-toot--action-success + "F" byline-region remove)) + (message (format "%s #%s" action id)))) + (message "Nothing to favorite here?!?")))) + +(defun mastodon-toot--kill () + "Kill `mastodon-toot-mode' buffer and window. + +Set `mastodon-toot--reply-to-id' to nil. +Set `mastodon-toot--content-warning' to nil." + (kill-buffer-and-window) + (setq mastodon-toot--reply-to-id nil + mastodon-toot--content-warning nil)) + +(defun mastodon-toot--cancel () + "Kill new-toot buffer/window. Does not POST content to Mastodon." + (interactive) + (mastodon-toot--kill)) + +(defun mastodon-toot--remove-docs () + "Get the body of a toot from the current compose buffer." + (let ((re "^|=+=|$")) + (save-excursion + (goto-char 0) + (re-search-forward re nil nil 2) + (buffer-substring (+ 2 (point)) (+ 1 (length (buffer-string))))))) + +(defun mastodon-toot--send () + "Kill new-toot buffer/window and POST contents to the Mastodon instance." + (interactive) + (let* ((toot (mastodon-toot--remove-docs)) + (endpoint (mastodon-http--api "statuses")) + (spoiler (when mastodon-toot--content-warning + (read-string "Warning: "))) + (args `(("status" . ,toot) + ("in_reply_to_id" . ,mastodon-toot--reply-to-id) + ("sensitive" . ,(when mastodon-toot--content-warning + (symbol-name t))) + ("spoiler_text" . ,spoiler)))) + (mastodon-toot--kill) + (let ((response (mastodon-http--post endpoint args nil))) + (mastodon-http--triage response + (lambda () (message "Toot toot!")))))) + +(defun mastodon-toot--process-local (acct) + "Adds domain to local ACCT and replaces 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 "/" t)) " ")))) + +(defun mastodon-toot--mentions (status) + "Extract mentions from STATUS and process them into a string." + (interactive) + (let ((mentions (cdr (assoc 'mentions status)))) + (mapconcat (lambda(x) (mastodon-toot--process-local + (cdr (assoc 'acct x)))) + ;; reverse does not work on vectors in 24.5 + (reverse (append mentions nil)) + ""))) + +(defun mastodon-toot--reply () + "Reply to toot at `point'." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--as-string (mastodon-tl--field 'id toot))) + (account (mastodon-tl--field 'account toot)) + (user (cdr (assoc 'acct account))) + (mentions (mastodon-toot--mentions toot))) + (mastodon-toot (when user (concat (mastodon-toot--process-local user) + mentions)) + id))) + +(defun mastodon-toot--toggle-warning () + "Toggle `mastodon-toot--content-warning'." + (interactive) + (setq mastodon-toot--content-warning + (not mastodon-toot--content-warning))) + +;; we'll need to revisit this if the binds get +;; more diverse than two-chord bindings +(defun mastodon-toot--get-mode-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) (if (listp i) i)) + (cadr binds))))) + (mapcar (lambda (b) + (setf (car b) (vector prefix (car b))) + b) + bindings))) + +(defun mastodon-toot--format-kbind-command (cmd) + "Format CMD to be more readable. +e.g. mastodon-toot--send -> Send." + (let* ((str (symbol-name cmd)) + (re "--\\(.*\\)$") + (str2 (save-match-data + (string-match re str) + (match-string 1 str)))) + (capitalize (replace-regexp-in-string "-" " " str2)))) + +(defun mastodon-toot--format-kbind (kbind) + "Format a single keybinding, KBIND, for display in documentation." + (let ((key (help-key-description (car kbind) nil)) + (command (mastodon-toot--format-kbind-command (cdr kbind)))) + (format "\t%s - %s" key command))) + +(defun mastodon-toot--format-kbinds (kbinds) + "Format a list keybindings, KBINDS, for display in documentation." + (mapconcat 'identity (cons "" (mapcar #'mastodon-toot--format-kbind kbinds)) + "\n")) + +(defun mastodon-toot--make-mode-docs () + "Create formatted documentation text for the mastodon-toot-mode." + (let ((kbinds (mastodon-toot--get-mode-kbinds))) + (concat + "|=================================================================|\n" + " Compose a new toot here. The following keybindings are available:" + (mastodon-toot--format-kbinds kbinds) + "\n|=================================================================|\n\n"))) + +(defun mastodon-toot--display-docs () + "Display documentation about mastodon-toot mode." + (insert + (propertize + (mastodon-toot--make-mode-docs) + 'face 'comment))) + +(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id) + "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." + (when reply-to-user + (insert (format "%s " reply-to-user)) + (setq mastodon-toot--reply-to-id reply-to-id))) + +(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id) + "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." + (let* ((buffer-exists (get-buffer "*new toot*")) + (buffer (or buffer-exists (get-buffer-create "*new toot*")))) + (switch-to-buffer-other-window buffer) + (when (not buffer-exists) + (mastodon-toot--display-docs) + (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) + (mastodon-toot-mode t))) + +(define-minor-mode mastodon-toot-mode + "Minor mode to capture Mastodon toots." + :group 'mastodon-toot + :keymap mastodon-toot-mode-map + :global nil) + +(provide 'mastodon-toot) +;;; mastodon-toot.el ends here
new file mode 100644 --- /dev/null +++ b/elpa/mastodon-0.8.0/mastodon.el @@ -0,0 +1,192 @@ +;;; mastodon.el --- Client for Mastodon -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Johnson Denen +;; Author: Johnson Denen <johnson.denen@gmail.com> +;; Version: 0.8.0 +;; Package-Requires: ((emacs "24.4")) +;; Homepage: https://github.com/jdenen/mastodon.el + +;; This file is not part of GNU Emacs. + +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; mastodon.el is an Emacs client for Mastodon <https://github.com/tootsuite/mastodon>, +;; the federated microblogging social network. It is very much a work-in-progress, but +;; it is a labor of love. + +;;; Code: +(declare-function discover-add-context-menu "discover") +(declare-function emojify-mode "emojify") +(autoload 'special-mode "simple") +(autoload 'mastodon-tl--get-federated-timeline "mastodon-tl") +(autoload 'mastodon-tl--get-home-timeline "mastodon-tl") +(autoload 'mastodon-tl--get-local-timeline "mastodon-tl") +(autoload 'mastodon-tl--get-tag-timeline "mastodon-tl") +(autoload 'mastodon-tl--goto-next-toot "mastodon-tl") +(autoload 'mastodon-tl--goto-prev-toot "mastodon-tl") +(autoload 'mastodon-tl--next-tab-item "mastodon-tl") +(autoload 'mastodon-tl--previous-tab-item "mastodon-tl") +(autoload 'mastodon-tl--thread "mastodon-tl") +(autoload 'mastodon-tl--toggle-spoiler-text-in-toot "mastodon-tl") +(autoload 'mastodon-tl--update "mastodon-tl") +(autoload 'mastodon-notifications--get "mastodon-notifications") +(autoload 'mastodon-profile--get-toot-author "mastodon-profile") +(autoload 'mastodon-profile--make-author-buffer "mastodon-profile") +(autoload 'mastodon-profile--show-user "mastodon-profile") +(autoload 'mastodon-toot--compose-buffer "mastodon-toot") +(autoload 'mastodon-toot--reply "mastodon-toot") +(autoload 'mastodon-toot--toggle-boost "mastodon-toot") +(autoload 'mastodon-toot--toggle-favourite "mastodon-toot") + +(defgroup mastodon nil + "Interface with Mastodon." + :prefix "mastodon-" + :group 'external) + +(defcustom mastodon-instance-url "https://mastodon.social" + "Base URL for the Masto instance from which you toot." + :group 'mastodon + :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." + :group 'mastodon + :type 'string) + +(defvar mastodon-mode-map + (let ((map (make-sparse-keymap))) + ;; Navigation + (define-key map (kbd "j") #'mastodon-tl--goto-next-toot) + (define-key map (kbd "k") #'mastodon-tl--goto-prev-toot) + (define-key map (kbd "h") #'mastodon-tl--next-tab-item) + (define-key map (kbd "l") #'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) + ;; Navigating to other buffers: + (define-key map (kbd "N") #'mastodon-notifications--get) + (define-key map (kbd "A") #'mastodon-profile--get-toot-author) + (define-key map (kbd "U") #'mastodon-profile--show-user) + (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 "t") #'mastodon-tl--thread) + (define-key map (kbd "T") #'mastodon-tl--get-tag-timeline) + (define-key map (kbd "q") #'kill-this-buffer) + (define-key map (kbd "Q") #'kill-buffer-and-window) + ;; Actions + (define-key map (kbd "c") #'mastodon-tl--toggle-spoiler-text-in-toot) + (define-key map (kbd "g") #'undefined) ;; override special mode binding + (define-key map (kbd "n") #'mastodon-toot) + (define-key map (kbd "r") #'mastodon-toot--reply) + (define-key map (kbd "u") #'mastodon-tl--update) + (define-key map (kbd "b") #'mastodon-toot--toggle-boost) + (define-key map (kbd "f") #'mastodon-toot--toggle-favourite) + ;; Finally, return the map: + map) + "Keymap for `mastodon-mode'.") + +(defcustom mastodon-mode-hook nil + "Hook run when entering Mastodon mode." + :type 'hook + :options '(provide-discover-context-menu) + :group 'mastodon) + +(defface mastodon-handle-face + '((t :inherit default)) + "Face used for user display names.") + +(defface mastodon-display-name-face + '((t :inherit warning)) + "Face used for user display names.") + +(defface mastodon-boosted-face + '((t :inherit highlight :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.") + +;;;###autoload +(defun mastodon () + "Connect Mastodon client to `mastodon-instance-url' instance." + (interactive) + (mastodon-tl--get-home-timeline)) + +;;;###autoload +(defun mastodon-toot (&optional user reply-to-id) + "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." + (interactive) + (mastodon-toot--compose-buffer user reply-to-id)) + +;;;###autoload +(add-hook 'mastodon-mode-hook (lambda () + (when (require 'emojify nil :noerror) + (emojify-mode t)))) + +(define-derived-mode mastodon-mode special-mode "Mastodon" + "Major mode for Mastodon, the federated microblogging network." + :group 'mastodon + (read-only-mode 1)) + +(with-eval-after-load 'mastodon + (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" "Author" mastodon-profile--get-toot-author) + ("b" "Boost" mastodon-toot--boost) + ("c" "Toggle content" mastodon-tl--toggle-spoiler-text-in-toot) + ("f" "Favourite" mastodon-toot--favourite) + ("j" "Next" mastodon-tl--goto-next-toot) + ("k" "Prev" mastodon-tl--goto-prev-toot) + ("n" "Send" mastodon-toot) + ("r" "Reply" mastodon-toot--reply) + ("t" "Thread" mastodon-tl--thread) + ("u" "Update" mastodon-tl--update) + ("U" "Users" mastodon-profile--show-user)) + ("Timelines" + ("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) + ("T" "Tag" mastodon-tl--get-tag-timeline)) + ("Quit" + ("q" "Quit mastodon buffer. Leave window open." kill-this-buffer) + ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window))))))) + +(provide 'mastodon) +;;; mastodon.el ends here