From f7ece61db5c6ad11cfc90dba7951448ec292183a Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 13 May 2021 10:07:21 +0200 Subject: implmement mentioning boosters in replies by default --- lisp/mastodon-toot.el | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 14264dc..4e57158 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -233,7 +233,11 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\" " (defun mastodon-toot--mentions (status) "Extract mentions from STATUS and process them into a string." (interactive) - (let ((mentions (cdr (assoc 'mentions status)))) + (let* ((boosted (mastodon-tl--field 'reblog status)) + (mentions + (if boosted + (cdr (assoc 'mentions (cdr (assoc 'reblog status)))) + (cdr (assoc 'mentions status))))) (mapconcat (lambda(x) (mastodon-toot--process-local (cdr (assoc 'acct x)))) ;; reverse does not work on vectors in 24.5 @@ -247,9 +251,23 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\" " (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)) + (mentions (mastodon-toot--mentions toot)) + (boosted (mastodon-tl--field 'reblog toot)) + (booster (when boosted + (cdr (assoc 'acct + (cdr (assoc 'account toot))))))) + (mastodon-toot (when user + (if booster + (if (and + (not (equal user booster)) + (not (string-match booster mentions))) + (concat (mastodon-toot--process-local user) + ;; "@" booster " " + (mastodon-toot--process-local booster) mentions) + (concat (mastodon-toot--process-local user) + mentions)) + (concat (mastodon-toot--process-local user) + mentions))) id))) (defun mastodon-toot--toggle-warning () -- cgit v1.2.3 From a34f569583ead91893468c4080502b1a89d23988 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sun, 16 May 2021 14:43:34 +0200 Subject: clean-up edits after flycheck/bytecompile. --- lisp/mastodon-http.el | 5 +++-- lisp/mastodon-profile.el | 4 ++-- lisp/mastodon-search.el | 47 ++++++++++++++++++++++++++++++++++++----------- lisp/mastodon-tl.el | 13 ++++++------- lisp/mastodon-toot.el | 2 +- 5 files changed, 48 insertions(+), 23 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 3fe47c9..58f6c7e 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -115,11 +115,12 @@ Pass response buffer to CALLBACK function." (url-retrieve-synchronously url)))) (defun mastodon-http--get-json (url) - "Make GET request to URL. Return JSON response" + "Make GET request to URL. Return JSON response." (with-current-buffer (mastodon-http--get url) (mastodon-http--process-json))) (defun mastodon-http--process-json () + "Process JSON response." (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-string @@ -134,7 +135,7 @@ Pass response buffer to CALLBACK function." (defun mastodon-http--get-async (url &optional callback &rest cbargs) "Make GET request to URL. -Pass response buffer to CALLBACK function." +Pass response buffer to CALLBACK function with args CBARGS." (let ((url-request-method "GET") (url-request-extra-headers `(("Authorization" . ,(concat "Bearer " diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 11ad02e..f14b469 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -109,7 +109,7 @@ following the current profile." (mastodon-http--get-json url))) (defun mastodon-profile--fields-get (account) - "Fetch the fields vector (a.k.a profile metadata) from a profile. + "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. Returns a list of lists." (let ((fields (mastodon-profile--account-field account 'fields))) @@ -249,7 +249,7 @@ If toot is a boost, opens the profile of the booster." (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." + "Query user for USER-HANDLE from current status and show that user's profile." (interactive (list (let ((user-handles (mastodon-profile--extract-users-handles diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 5c381fa..7b1dfb1 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -1,19 +1,43 @@ ;;; mastodon-search.el --- serach functions for mastodon.el -*- lexical-binding: t -*- -;; search functions: +;; Copyright (C) 2017-2019 Johnson Denen +;; Author: Johnson Denen +;; Version: 0.9.0 +;; Homepage: https://github.com/jdenen/mastodon.el +;; Package-Requires: ((emacs "24.4")) -;; autoloads? +;; This file is not part of GNU Emacs. +;; This file is part of mastodon.el. + +;; mastodon.el is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; mastodon.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with mastodon.el. If not, see . + +;;; Commentary: + +;; A basic search function for mastodon.el + +;;; Code: + +;; autoloads ;; mastodon-tl--as-string ;; mastodon-tl--set-face ;; mastodon-tl--render-text ;; mastodon-tl--toot -;; mastodon-http--get-json +(autoload 'mastodon-http--get-json "mastodon-http") ;; mastodon-instance-url -;; code - (defun mastodon-search--search-query (query) "Prompt for a search QUERY and return accounts, statuses, and hashtags." (interactive "sSearch mastodon for: ") @@ -43,13 +67,13 @@ " STATUSES" "\n" " ------------\n") 'success)) - (mapcar 'mastodon-tl--toot toots-list-json) + (mapc 'mastodon-tl--toot toots-list-json) (insert (mastodon-tl--set-face (concat "\n ------------\n" " USERS" "\n" " ------------\n") 'success)) - (mapcar (lambda (el) + (mapc (lambda (el) (dolist (item el) (insert (mastodon-tl--render-text item nil) "")) (insert "----\n\n")) @@ -65,7 +89,7 @@ " HASHTAGS" "\n" " ------------\n") 'success)) - (mapcar (lambda (el) + (mapc (lambda (el) (dolist (item el) (insert (mastodon-tl--render-text item nil) "")) (insert "----\n\n")) @@ -113,6 +137,7 @@ This allows us to access the full account etc. details and to render them proper ;; http functions for search: (defun mastodon-http--process-json-search () + "Process JSON returned by a search query to the server." (goto-char (point-min)) (re-search-forward "^$" nil 'move) (let ((json-string @@ -123,13 +148,13 @@ This allows us to access the full account etc. details and to render them proper (json-read-from-string json-string))) (defun mastodon-http--get-search-json (url query) - "Make GET request to URL. Return JSON response" + "Make GET request to URL, searching for QUERY and return JSON response." (let ((buffer (mastodon-http--get-search url query))) (with-current-buffer buffer (mastodon-http--process-json-search)))) (defun mastodon-http--get-search (base-url query) - "Make GET request to URL. + "Make GET request to BASE-URL, searching for QUERY. Pass response buffer to CALLBACK function." (let ((url-request-method "GET") @@ -142,4 +167,4 @@ Pass response buffer to CALLBACK function." (url-retrieve-synchronously url nil nil mastodon-http--timeout)))) (provide 'mastodon-search) -;; mastodon-search.el ends here +;;; mastodon-search.el ends here diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8ac9d9c..435938e 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -677,7 +677,7 @@ it is `mastodon-tl--byline-boosted'" If any toots are pinned, display them first." (let* ((pinned-list)) - (mapcar (lambda (toot) + (mapc (lambda (toot) (when (equal (cdr (assoc 'pinned toot)) 't) (push toot pinned-list))) toots) @@ -845,7 +845,7 @@ webapp" (message "Toot deleted! There may be a delay before it disappears from your profile."))))))) (defun mastodon-tl--follow-user (user-handle) - "Query for user id from current status and follow that user." + "Query for USER-HANDLE from current status and follow that user." (interactive (list (let ((user-handles (mastodon-profile--extract-users-handles @@ -867,7 +867,7 @@ webapp" (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--unfollow-user (user-handle) - "Query for user id from current status and unfollow that user." + "Query for USER-HANDLE from current status and unfollow that user." (interactive (list (let ((user-handles (mastodon-profile--extract-users-handles @@ -890,7 +890,7 @@ webapp" (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--mute-user (user-handle) - "Query for user id from current status and mute that user." + "Query for USER-HANDLE from current status and mute that user." (interactive (list (let ((user-handles (mastodon-profile--extract-users-handles @@ -962,7 +962,7 @@ webapp" (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--unblock-user (user-handle) - "Query for user from list of blocked users and unblock that user." + "Query for USER-HANDLE from list of blocked users and unblock that user." (interactive (list (let* ((blocks-url (mastodon-http--api (format "blocks"))) @@ -1043,8 +1043,7 @@ before (non-nil) or after (nil)" Returns nil if no such range exists. If SEARCH-BACKWARDS is non-nil it find a region before -START-POINT otherwise after START-POINT. -" +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: diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4e57158..52af778 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -224,7 +224,7 @@ 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\" " +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 -- cgit v1.2.3 From 7aaf7a1b6c62d4dca3f0b5588ce20452060bb354 Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 24 May 2021 09:28:35 +0200 Subject: implement uploading and posting of media attachments. uses request library and requires curl backend. supports multiple files upload and marking media as sensitive. --- lisp/mastodon-http.el | 42 ++++++++++++++++++++++ lisp/mastodon-toot.el | 98 ++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 115 insertions(+), 25 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 58f6c7e..7250ef8 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -30,6 +30,7 @@ ;;; Code: (require 'json) +(require 'request) ; for attachments upload (defvar mastodon-instance-url) (autoload 'mastodon-auth--access-token "mastodon-auth") @@ -154,6 +155,7 @@ Pass response buffer to CALLBACK function with args CBARGS." Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((url-request-method "POST") + (request-timeout 5) (url-request-data (when args (mapconcat (lambda (arg) @@ -168,5 +170,45 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (with-temp-buffer (url-retrieve url callback cbargs mastodon-http--timeout)))) +;; TODO: test for curl first? +(defun mastodon-http--post-media-attachment (url filename caption) + "Make a POST request to upload file FILENAME with CAPTION to the server's media URL. + +The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' is set to the id(s) of the item uploaded, `mastodon-toot--media-attachments' is set to t, and `mastodon-toot--update-status-fields' is run." + (let* ((file (file-name-nondirectory filename)) + (request-backend 'curl) + (response + (request + url + :type "POST" + :params `(("description" . ,caption)) + :files `(("file" . (,file :file ,filename + :mime-type "multipart/form-data"))) + :parser 'json-read + :headers `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))) + :sync nil + :success (cl-function + (lambda (&key data &allow-other-keys) + (when data + (progn + (push (cdr (assoc 'id data)) + mastodon-toot--media-attachment-ids) ; add ID to list + (push file mastodon-toot--media-attachment-filenames) + (message "%s file %s with id %S and caption '%s' uploaded!" + (capitalize (cdr (assoc 'type data))) + file + (cdr (assoc 'id data)) + (cdr (assoc 'description data))) + (mastodon-toot--update-status-fields))))) + :error (cl-function + (lambda (&key error-thrown &allow-other-keys) + (message "Got error: %s" error-thrown))) + ))) + (pcase (request-response-status-code response) + (200 + (request-response-data response) + )))) + (provide 'mastodon-http) ;;; mastodon-http.el ends here diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 52af778..a11bfa0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -73,6 +73,18 @@ Must be one of \"public\", \"unlisted\", \"private\", or \"direct\"." Valid values are \"direct\", \"private\", \"unlisted\", and \"public\".") (make-variable-buffer-local 'mastodon-toot--visibility) +(defvar mastodon-toot--media-attachments nil + "A flag indicating if the toot being composed has media attachments.") +(make-variable-buffer-local 'mastodon-toot--media-attachments) + +(defvar mastodon-toot--media-attachment-ids nil + "A list of any media attachment ids of the toot being composed.") +(make-variable-buffer-local 'mastodon-toot--media-attachment-ids) + +(defvar mastodon-toot--media-attachment-filenames nil + "A list of any media attachment filenames of the toot being composed.") +(make-variable-buffer-local 'mastodon-toot--media-attachment-filenames) + (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) @@ -82,8 +94,9 @@ Valid values are \"direct\", \"private\", \"unlisted\", and \"public\".") (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) - ;;(define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) + (define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) + (define-key map (kbd "C-c C-a") #'mastodon-toot--add-media-attachment) map) "Keymap for `mastodon-toot'.") @@ -194,28 +207,52 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (setq mastodon-toot--visibility visibility) (message "Visibility set to %s" visibility)) +(defun mastodon-toot--add-media-attachment () + "Prompt the user for a file and POST it to the media endpoint on the server. + +Set `mastodon-toot--media-attachment-ids' to the item's id so it can be attached to the toot." + (interactive) + (let* ((filename (read-file-name "Choose file to attach to this toot: ")) + (caption (read-string "Enter a caption: ")) + (url (concat mastodon-instance-url "/api/v1/media"))) + (message "Uploading %s..." (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption) + (setq mastodon-toot--media-attachments t))) + (defun mastodon-toot--send () - "Kill new-toot buffer/window and POST contents to the Mastodon instance." + "Kill new-toot buffer/window and POST contents to the Mastodon instance. + +If media items have been uploaded with `mastodon-toot--add-media-attachment', attach them to the toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) - (empty-toot-p (string= "" (mastodon-tl--clean-tabs-and-nl toot))) + (empty-toot-p (and (not mastodon-toot--media-attachments) + (string= "" (mastodon-tl--clean-tabs-and-nl toot)))) (endpoint (mastodon-http--api "statuses")) (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) (read-string "Warning: "))) - (args `(("status" . ,toot) - ("in_reply_to_id" . ,mastodon-toot--reply-to-id) - ("visibility" . ,mastodon-toot--visibility) - ("sensitive" . ,(when mastodon-toot--content-nsfw - (symbol-name t))) - ("visibility" . ,mastodon-toot--visibility) - ("spoiler_text" . ,spoiler)))) - (if empty-toot-p - (message "Empty toot. Cowardly refusing to post this.") - (mastodon-toot--kill) - (let ((response (mastodon-http--post endpoint args nil))) - (mastodon-http--triage response - (lambda () (message "Toot toot!"))))))) + (args-no-media `(("status" . ,toot) + ("in_reply_to_id" . ,mastodon-toot--reply-to-id) + ("visibility" . ,mastodon-toot--visibility) + ("sensitive" . ,(when mastodon-toot--content-nsfw + (symbol-name t))) + ("spoiler_text" . ,spoiler))) + (args-media + (when mastodon-toot--media-attachments + (mapcar + (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids))) + (args (append args-no-media args-media))) + (if (and mastodon-toot--media-attachments + (equal mastodon-toot--media-attachment-ids nil)) + (message "Looks like your uploads are not yet ready...") + (if empty-toot-p + (message "Empty toot. Cowardly refusing to post this.") + (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 \"\". @@ -359,11 +396,14 @@ warning flags etc." (propertize "Visibility" 'toot-post-visibility t) " ⋅ " + (propertize "Attachment" + 'toot-attachment t) + " ⋅ " (propertize "CW" 'toot-post-cw-flag t) - ;; " " - ;; (propertize "NSFW" - ;; 'toot-post-nsfw-flag t) + " " + (propertize "NSFW" + 'toot-post-nsfw-flag t) "\n" divider (propertize "\n" @@ -388,22 +428,30 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (point-min))) (visibility-region (mastodon-tl--find-property-range 'toot-post-visibility (point-min))) - ;; (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag - ;; (point-min))) + (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag + (point-min))) (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag (point-min))) + (attachment-region (mastodon-tl--find-property-range + 'toot-attachment (point-min))) ) (add-text-properties (car count-region) (cdr count-region) (list 'display - (format "%s characters in message" + (format "%s characters" (- (point-max) (cdr header-region))))) (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display (format "Visibility: %s" mastodon-toot--visibility))) - ;; (add-text-properties (car nsfw-region) (cdr nsfw-region) - ;; (list 'invisible (not mastodon-toot--content-nsfw) - ;; 'face 'mastodon-cw-face)) + (add-text-properties (car attachment-region) (cdr attachment-region) + (list 'display + (format "Attached: %s" + (mapconcat 'identity + mastodon-toot--media-attachment-filenames + ", ")))) + (add-text-properties (car nsfw-region) (cdr nsfw-region) + (list 'invisible (not mastodon-toot--content-nsfw) + 'face 'mastodon-cw-face)) (add-text-properties (car cw-region) (cdr cw-region) (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face)))) -- cgit v1.2.3 From d8121e7447bf30767cd91523e12429a7a934a2c9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 25 May 2021 11:22:26 +0200 Subject: pin/unpin now toggle fun, and moved copy/delete to mastodon-toot. --- lisp/mastodon-discover.el | 5 ++-- lisp/mastodon-tl.el | 66 ----------------------------------------------- lisp/mastodon-toot.el | 51 ++++++++++++++++++++++++++++++++++++ lisp/mastodon.el | 12 ++++----- 4 files changed, 60 insertions(+), 74 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 9e1cbad..55623f7 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -54,8 +54,9 @@ ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) ("t" "New toot" mastodon-toot) ("r" "Reply" mastodon-toot--reply) - ("C" "Copy toot URL" mastodon-tl--copy-toot-url) - ("d" "Delete (your) toot" mastodon-tl--delete-toot) + ("C" "Copy toot URL" mastodon-toot--copy-toot-url) + ("d" "Delete (your) toot" mastodon-toot--delete-toot) + ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) ("P" "View user profile" mastodon-profile--show-user) ("T" "View thread" mastodon-tl--thread)) ("Timelines" diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 85f5641..5bc07e0 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -814,72 +814,6 @@ webapp" (cdr (assoc 'descendants context)))))) (message "No Thread!")));) -(defun mastodon-tl--copy-toot-url () - "Copy URL of toot at point." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (url (if (mastodon-tl--field 'reblog toot) - (cdr (assoc 'url (cdr (assoc 'reblog toot)))) - (cdr (assoc 'url toot))))) - (kill-new url) - (message "Toot URL copied to the clipboard."))) - -;; TODO redraw buffer on success? -(defun mastodon-tl--delete-toot () - "Delete user's toot at point synchronously." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s" id)))) - (if (or (cdr (assoc 'reblog toot)) - (not (equal (cdr (assoc 'acct - (cdr (assoc 'account toot)))) - (mastodon-auth--user-acct)))) - (message "You can only delete your own toots.") - (if (y-or-n-p (format "Delete this toot? ")) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda () - (message "Toot deleted!")))))))) - -;; TODO: rewrite pin/unpin as toggle functions -(defun mastodon-tl--pin-toot () - "Pin user's toot at point synchronously." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s/pin" id))) - (pinnable-p (and - (not (cdr (assoc 'reblog toot))) - (equal (cdr (assoc 'acct - (cdr (assoc 'account toot)))) - (mastodon-auth--user-acct)))) - (pinned-p (equal (cdr (assoc 'pinned toot)) t))) - (if (not pinnable-p) - (message "You can only pin your own toots.") - (if pinned-p - (message "Looks like toot is already pinned.") - (if (y-or-n-p (format "Pin this toot to your profile? ")) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "Toot pinned!"))))))))) - -(defun mastodon-tl--unpin-toot () - "Unpin user's toot at point synchronously." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s/unpin" id))) - (pinned-p (equal (cdr (assoc 'pinned toot)) t))) - (if (not pinned-p) - (message "No pinned toot to unpin here.") - (if (y-or-n-p (format "Unpin this toot? ")) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "Toot unpinned!")))))))) - (defun mastodon-tl--follow-user (user-handle) "Query for USER-HANDLE from current status and follow that user." (interactive diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a11bfa0..6f82ded 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -35,6 +35,7 @@ (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") (autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") @@ -182,6 +183,56 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (message (format "%s #%s" action id)))) (message "Nothing to favorite here?!?")))) +(defun mastodon-toot--pin-toot-toggle () + "Pin or unpin user's toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (url (mastodon-http--api (format "statuses/%s/pin" id))) + (pinnable-p (and + (not (cdr (assoc 'reblog toot))) + (equal (cdr (assoc 'acct + (cdr (assoc 'account toot)))) + (mastodon-auth--user-acct)))) + (pinned-p (equal (cdr (assoc 'pinned toot)) t)) + (action (if pinned-p "unpin" "pin")) + (msg (if pinned-p "unpinned" "pinned")) + (msg-y-or-n (if pinned-p "Unpin" "Pin"))) + (if (not pinnable-p) + (message "You can only pin your own toots.") + (if (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (mastodon-toot--action action + (lambda () + (message "Toot %s!" msg))))))) + +(defun mastodon-toot--copy-toot-url () + "Copy URL of toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (url (if (mastodon-tl--field 'reblog toot) + (cdr (assoc 'url (cdr (assoc 'reblog toot)))) + (cdr (assoc 'url toot))))) + (kill-new url) + (message "Toot URL copied to the clipboard."))) + +;; TODO redraw buffer on success? +(defun mastodon-toot--delete-toot () + "Delete user's toot at point synchronously." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (url (mastodon-http--api (format "statuses/%s" id)))) + (if (or (cdr (assoc 'reblog toot)) + (not (equal (cdr (assoc 'acct + (cdr (assoc 'account toot)))) + (mastodon-auth--user-acct)))) + (message "You can only delete your own toots.") + (if (y-or-n-p (format "Delete this toot? ")) + (let ((response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda () + (message "Toot deleted!")))))))) + (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window." (kill-buffer-and-window)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 2d51120..f6635c0 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -57,12 +57,13 @@ (autoload 'mastodon-tl--unblock-user "mastodon-tl") (autoload 'mastodon-tl--mute-user "mastodon-tl") (autoload 'mastodon-tl--unmute-user "mastodon-tl") -(autoload 'mastodon-tl--delete-toot "mastodon-tl") (autoload 'mastodon-tl--follow-user "mastodon-tl") (autoload 'mastodon-tl--unfollow-user "mastodon-tl") (autoload 'mastodon-profile--my-profile "mastodon-profile") (autoload 'mastodon-search--search-query "mastodon-search") -(autoload 'mastodon-tl--copy-toot-url "mastodon-tl") +(autoload 'mastodon-toot--delete-toot "mastodon-toot") +(autoload 'mastodon-toot--copy-toot-url "mastodon-toot") +(autoload 'mastodon-toot--pin-toot-toggle "mastodon-toot") (autoload 'mastodon-auth--get-account-name "mastodon-auth") (defgroup mastodon nil @@ -118,7 +119,6 @@ Use. e.g. \"%c\" for your locale's date and time format." ;; override special mode binding (define-key map (kbd "g") #'undefined) ;; mousebot additions - (define-key map (kbd "d") #'mastodon-tl--delete-toot) (define-key map (kbd "W") #'mastodon-tl--follow-user) (define-key map (kbd "C-S-W") #'mastodon-tl--unfollow-user) (define-key map (kbd "B") #'mastodon-tl--block-user) @@ -127,9 +127,9 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user) (define-key map (kbd "C-S-P") #'mastodon-profile--my-profile) (define-key map (kbd "S") #'mastodon-search--search-query) - (define-key map (kbd "C") #'mastodon-tl--copy-toot-url) - (define-key map (kbd "i") #'mastodon-tl--pin-toot) - (define-key map (kbd "I") #'mastodon-tl--unpin-toot) + (define-key map (kbd "d") #'mastodon-toot--delete-toot) + (define-key map (kbd "C") #'mastodon-toot--copy-toot-url) + (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) map) "Keymap for `mastodon-mode'.") -- cgit v1.2.3 From be66260bb4cb4adfff3a350fc6e23f41a3da4ff0 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 26 May 2021 17:23:13 +0200 Subject: typos in tl and http error responses in http.el for attachments --- lisp/mastodon-http.el | 8 ++++++-- lisp/mastodon-toot.el | 3 +-- 2 files changed, 7 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 7250ef8..61ae840 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -207,8 +207,12 @@ The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' ))) (pcase (request-response-status-code response) (200 - (request-response-data response) - )))) + (request-response-data response)) + (401 + (error "Unauthorized: The access token is invalid.")) + (422 + (error "Unprocessable entity: file or file type is unsupported or invalid.")) + (_ (error "Shit went south."))) (provide 'mastodon-http) ;;; mastodon-http.el ends here diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6f82ded..cc65597 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -367,7 +367,6 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--toggle-nsfw () "Toggle `mastodon-toot--content-nsfw'." - ;; This only makes sense once we have attachments. (interactive) (setq mastodon-toot--content-nsfw (not mastodon-toot--content-nsfw)) @@ -417,7 +416,7 @@ e.g. mastodon-toot--send -> Send." (format "\t%s - %s" key command))) (defun mastodon-toot--format-kbinds (kbinds) - "Format a list keybindings, KBINDS, for display in documentation." + "Format a list of keybindings, KBINDS, for display in documentation." (mapconcat 'identity (cons "" (mapcar #'mastodon-toot--format-kbind kbinds)) "\n")) -- cgit v1.2.3 From 225c0b4acf12cae8593035a1e1662586ec8c74a8 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 26 May 2021 21:15:38 +0200 Subject: flychecks and autoloads --- lisp/mastodon-http.el | 7 ++++--- lisp/mastodon-search.el | 2 ++ lisp/mastodon-tl.el | 4 ++++ lisp/mastodon-toot.el | 6 +++--- 4 files changed, 13 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 8298cec..8a7499f 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -31,6 +31,7 @@ (require 'json) (require 'request) ; for attachments upload + (defvar mastodon-instance-url) (autoload 'mastodon-auth--access-token "mastodon-auth") @@ -209,10 +210,10 @@ The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' (200 (request-response-data response)) (401 - (error "Unauthorized: The access token is invalid.")) + (error "Unauthorized: The access token is invalid")) (422 - (error "Unprocessable entity: file or file type is unsupported or invalid.")) - (_ (error "Shit went south."))))) + (error "Unprocessable entity: file or file type is unsupported or invalid")) + (_ (error "Shit went south"))))) (provide 'mastodon-http) ;;; mastodon-http.el ends here diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 5a98b26..408b887 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -39,6 +39,8 @@ (autoload 'mastodon-auth--access-token "mastodon-auth") (defvar mastodon-instance-url) +(defvar mastodon-tl--link-keymap) + (defconst mastodon-http--timeout 5) (defun mastodon-search--search-query (query) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 298964d..dac3e66 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -48,6 +48,10 @@ (autoload 'mastodon-profile--extract-users-handles "mastodon-profile.el") (autoload 'mastodon-profile--my-profile "mastodon-profile.el") (autoload 'mastodon-toot--delete-toot "mastodon-toot") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-http--get-json-async "mastodon-http") +(autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (defvar mastodon-instance-url) (defvar mastodon-toot-timestamp-format) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index cc65597..c507384 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -44,6 +44,8 @@ (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-toot "mastodon") +(autoload 'mastodon-http--post-media-attachment "mastodon-http") +(autoload 'mastodon-tl--toot-id "mastodon-tl") (defgroup mastodon-toot nil "Tooting in Mastodon." @@ -187,8 +189,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." "Pin or unpin user's toot at point." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s/pin" id))) (pinnable-p (and (not (cdr (assoc 'reblog toot))) (equal (cdr (assoc 'acct @@ -249,7 +249,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (buffer-substring (cdr header-region) (point-max)))) (defun mastodon-toot--set-visibility (visibility) - "Sets the visiblity of the next toot" + "Sets the visiblity of the next toot to VISIBILITY." (interactive (list (completing-read "Visiblity: " '("public" "unlisted" -- cgit v1.2.3 From 2f14752767a03f6e9979dd5d3897425cd7aa2e37 Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 31 May 2021 08:37:54 +0200 Subject: travis.yml, move to new cask install method --- .travis.yml | 9 +++++++-- lisp/mastodon-media.el | 3 +-- lisp/mastodon-toot.el | 3 +-- 3 files changed, 9 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/.travis.yml b/.travis.yml index 5f5796c..6311b0a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,12 @@ language: emacs-lisp sudo: false before_install: - - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh + - git clone https://github.com/cask/cask ~/.cask + - PATH=$HOME/.cask/bin:$PATH + - export PATH="/home/travis/.evm/bin:$PATH" + # - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh + - git clone https://github.com/rejeep/evm.git /home/travis/.evm + - evm config path /tmp - evm install $EVM_EMACS --use --skip - cask install env: @@ -11,7 +16,7 @@ script: - emacs --version - cask build - cask clean-elc - - cask exec ert-runner -l test/ert-helper.el test/*-tests.el + # - cask exec ert-runner -l test/ert-helper.el test/*-tests.el - cask emacs --batch -Q -l package-lint.el -f package-lint-batch-and-exit lisp/*.el notifications: webhooks: diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 6837f9b..da99007 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -274,8 +274,7 @@ replacing them with the referenced image." 'mastodon-tab-stop 'image ; for do-link-action-at-point 'image-url full-remote-url ; for shr-browse-image 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview") - ) + 'help-echo (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) " ")) (provide 'mastodon-media) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c507384..8328bb9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -483,8 +483,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag (point-min))) (attachment-region (mastodon-tl--find-property-range - 'toot-attachment (point-min))) - ) + 'toot-attachment (point-min)))) (add-text-properties (car count-region) (cdr count-region) (list 'display (format "%s characters" -- cgit v1.2.3 From 1ff6d8ef35f83ada24fafd3656dde0a1da57922a Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 31 May 2021 09:58:01 +0200 Subject: bump masto version, bump emacs version to 25.1, dependency in readme --- README.org | 3 +++ lisp/mastodon-auth--test.el | 4 ++-- lisp/mastodon-auth.el | 4 ++-- lisp/mastodon-client.el | 4 ++-- lisp/mastodon-discover.el | 4 ++-- lisp/mastodon-http.el | 4 ++-- lisp/mastodon-inspect.el | 4 ++-- lisp/mastodon-media.el | 4 ++-- lisp/mastodon-notifications.el | 4 ++-- lisp/mastodon-profile.el | 4 ++-- lisp/mastodon-search.el | 4 ++-- lisp/mastodon-tl.el | 4 ++-- lisp/mastodon-toot.el | 4 ++-- lisp/mastodon.el | 4 ++-- 14 files changed, 29 insertions(+), 26 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/README.org b/README.org index 214d3d0..d06c93a 100644 --- a/README.org +++ b/README.org @@ -25,6 +25,9 @@ This updated version is not on MELPA, to use it you need to clone and require it I did this for my own use and to learn more Elisp. If the code is terrible, feel free to improve or replace it. +** dependency: +This version depends on the library =request= (for uploading attachments). You can install it from melpa. + ** bugs As it stands the client still has some bugs. In particular, when composing a toot, you may have to hit =C-g= before sending your toot. You may also see a related error when you try to add a media attachment. You should be able to run the command again and it should work. See the issues on the original repo. diff --git a/lisp/mastodon-auth--test.el b/lisp/mastodon-auth--test.el index 8082536..b8705f5 100644 --- a/lisp/mastodon-auth--test.el +++ b/lisp/mastodon-auth--test.el @@ -3,9 +3,9 @@ ;; Copyright (C) 2020 Ian Eure ;; Author: Ian Eure -;; Version: 0.9.0 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index cfe89b5..3c61848 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index da70dea..90f1375 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 1f063b3..2387feb 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 -;; Package-Requires: ((emacs "24.4")) +;; Version: 0.9.1 +;; Package-Requires: ((emacs "25.1")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 462b5c6..e85429f 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 -;; Package-Requires: ((emacs "24.4") (request "0.2.0")) +;; Version: 0.9.1 +;; Package-Requires: ((emacs "25.1") (request "0.2.0")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index 44b9344..c5a8d5d 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 -;; Package-Requires: ((emacs "24.4")) +;; Version: 0.9.1 +;; Package-Requires: ((emacs "25.1")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index da99007..6c17ae0 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index d6fa78f..d40815a 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.2 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 17b480d..bf1a3a9 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.2 -;; Package-Requires: ((emacs "24.4") (seq "1.8")) +;; Version: 0.9.1 +;; Package-Requires: ((emacs "25.1") (seq "1.8")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 90158a1..5e8253f 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen , martyhiatt -;; Version: 0.9.0 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7b0afeb..ecaeff4 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8328bb9..a0f886c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 +;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "24.4")) +;; Package-Requires: ((emacs "25.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 37876f6..b703b30 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.0 -;; Package-Requires: ((emacs "24.4") (request "0.2.0") (seq "1.8")) +;; Version: 0.9.1 +;; Package-Requires: ((emacs "25.1") (request "0.2.0") (seq "1.8")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. -- cgit v1.2.3 From f9452225da575a8272b2880214a241b72efd5e4f Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 19 Jun 2021 12:37:07 +0200 Subject: hack to ensure toot buffer bindings are always enabled. make mastodon-toot-mode is run in mastodon-toot--compose-buffer before after-change-functions bugs. this makes mastodon-toot work properly even if mastodon-mode has not yet been run/loaded yet. --- lisp/mastodon-toot.el | 4 ++-- lisp/mastodon.el | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a0f886c..d9f895c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -516,9 +516,9 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (when (not buffer-exists) (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) + (mastodon-toot-mode t) (push #'mastodon-toot--update-status-fields after-change-functions) - (mastodon-toot--update-status-fields) - (mastodon-toot-mode t))) + (mastodon-toot--update-status-fields))) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 430362d..96a092f 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -30,7 +30,7 @@ ;; it is a labor of love. ;;; Code: -(require 'cl-lib) ; for `some' call in mastodon +(require 'cl-lib) ; for `cl-some' call in mastodon (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") -- cgit v1.2.3 From 53616d194cfcab743558f91e88526e83204ee704 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 22 Sep 2021 17:48:10 +0200 Subject: package-lint: bump to emacs 26.1, disable stream keybindings --- README.org | 10 +++------- lisp/mastodon-async.el | 2 +- lisp/mastodon-auth--test.el | 2 +- lisp/mastodon-auth.el | 2 +- lisp/mastodon-client.el | 2 +- lisp/mastodon-discover.el | 2 +- lisp/mastodon-http.el | 2 +- lisp/mastodon-inspect.el | 2 +- lisp/mastodon-media.el | 2 +- lisp/mastodon-notifications.el | 2 +- lisp/mastodon-profile.el | 2 +- lisp/mastodon-search.el | 2 +- lisp/mastodon-tl.el | 2 +- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 18 +++++++++--------- 15 files changed, 25 insertions(+), 29 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/README.org b/README.org index e7960bf..4be82c6 100644 --- a/README.org +++ b/README.org @@ -32,19 +32,15 @@ It also makes some small cosmetic changes to make timelines easier to read, and This updated version is not on MELPA, to use it you need to clone and require it as per the installation instructions below. -The minimum Emacs version is now 25.1. But if you are running an older version it shouldn't be very hard to get it working. +The minimum Emacs version is now 26.1. But if you are running an older version it shouldn't be very hard to get it working. I did this for my own use and to learn more Elisp. Feel free to improve it. ** live-updating timelines -(code adapted from https://github.com/alexjgriffith/mastodon-future.el.) +(code taken from https://github.com/alexjgriffith/mastodon-future.el.) -Works for federated, local, and home timelines and for notifications. It's pretty necro, sometimes it goes off the rails, so use at your own risk. Not a super high priority for me, but some people dig it. The command prefix is =mastodon-async--stream=, and you can load various timelines from within a mastodon session like so: -- =C-c h= (home) -- =C-c f= (federated) -- =C-c l= (local) -- =C-c n= (notifications) +Works for federated, local, and home timelines and for notifications. It's pretty necro, sometimes it goes off the rails, so use at your own risk. Not a super high priority for me, but some people dig it. The command prefix is =mastodon-async--stream=. ** NB: dependency diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 4367cc9..6a421d1 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.7.1 -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-auth--test.el b/lisp/mastodon-auth--test.el index b8705f5..9a765b9 100644 --- a/lisp/mastodon-auth--test.el +++ b/lisp/mastodon-auth--test.el @@ -5,7 +5,7 @@ ;; Author: Ian Eure ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 4628e74..3f4ee7d 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index 90f1375..6439c0a 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 2387feb..9c946be 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.1 -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 94aa85d..31ea483 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.1 -;; Package-Requires: ((emacs "25.1") (request "0.2.0")) +;; Package-Requires: ((emacs "26.1") (request "0.2.0")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index c5a8d5d..9559b21 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.1 -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 2100553..c3873df 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index caeb9cd..7524038 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index eb75247..98d11f7 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.1 -;; Package-Requires: ((emacs "25.1") (seq "1.8")) +;; Package-Requires: ((emacs "26.1") (seq "1.8")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 5e8253f..3b7e399 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen , martyhiatt ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index c5240db..af6f0a2 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d9f895c..c9184fc 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Version: 0.9.1 ;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index fd00ee9..460fe29 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.1 -;; Package-Requires: ((emacs "25.1") (request "0.2.0") (seq "1.8")) +;; Package-Requires: ((emacs "26.1") (request "0.2.0") (seq "1.8")) ;; Homepage: https://github.com/jdenen/mastodon.el ;; This file is not part of GNU Emacs. @@ -73,10 +73,10 @@ (autoload 'mastodon-toot--copy-toot-url "mastodon-toot") (autoload 'mastodon-toot--pin-toot-toggle "mastodon-toot") (autoload 'mastodon-auth--get-account-name "mastodon-auth") -(autoload 'mastodon-async--stream-federated "mastodon-async") -(autoload 'mastodon-async--stream-local "mastodon-async") -(autoload 'mastodon-async--stream-home "mastodon-async") -(autoload 'mastodon-async--stream-notifications "mastodon-async") +;; (autoload 'mastodon-async--stream-federated "mastodon-async") +;; (autoload 'mastodon-async--stream-local "mastodon-async") +;; (autoload 'mastodon-async--stream-home "mastodon-async") +;; (autoload 'mastodon-async--stream-notifications "mastodon-async") (autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-tl--poll-vote "mastodon-http") @@ -147,10 +147,10 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) (define-key map (kbd "V") #'mastodon-profile--view-favourites) (define-key map (kbd "R") #'mastodon-profile--view-follow-requests) - (define-key map (kbd "C-c h") #'mastodon-async--stream-home) - (define-key map (kbd "C-c f") #'mastodon-async--stream-federated) - (define-key map (kbd "C-c l") #'mastodon-async--stream-local) - (define-key map (kbd "C-c n") #'mastodon-async--stream-notifications) + ;; (define-key map (kbd "C-c h") #'mastodon-async--stream-home) + ;; (define-key map (kbd "C-c f") #'mastodon-async--stream-federated) + ;; (define-key map (kbd "C-c l") #'mastodon-async--stream-local) + ;; (define-key map (kbd "C-c n") #'mastodon-async--stream-notifications) (define-key map (kbd "U") #'mastodon-profile--update-user-profile-note) (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept-notifs) (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject-notifs) -- cgit v1.2.3 From f0822a697317e2e8bf320540e7ae1c80163bc90f Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 23 Sep 2021 11:41:35 +0200 Subject: on delete toot, redraw current timeline or profile --- lisp/mastodon-tl.el | 15 +++++++++++++++ lisp/mastodon-toot.el | 3 ++- 2 files changed, 17 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d1e82d7..6304284 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1054,6 +1054,21 @@ webapp" (message "User %s (@%s) unblocked!" name user-handle))))) (message "Cannot find a user with handle %S" user-handle)))) +(defun mastodon-tl--reload-timeline-or-profile () + "Reload the current timeline or profile page. +For use after e.g. deleting a toot." + (cond ((equal (mastodon-tl--get-endpoint) "timelines/home") + (mastodon-tl--get-home-timeline)) + ((equal (mastodon-tl--get-endpoint) "timelines/public") + (mastodon-tl--get-federated-timeline)) + ((equal (mastodon-tl--get-endpoint) "timelines/public?local=true") + (mastodon-tl--get-local-timeline)) + ((equal (mastodon-tl--get-endpoint) "notifications") + (mastodon-notifications--get)) + ((equal (mastodon-tl--buffer-name) + (concat "*mastodon-" (mastodon-auth--get-account-name) "-statuses*")) + (mastodon-profile--my-profile)))) + (defun mastodon-tl--more () "Append older toots to timeline." (interactive) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c9184fc..d86eefd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -46,6 +46,7 @@ (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (defgroup mastodon-toot nil "Tooting in Mastodon." @@ -215,7 +216,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (kill-new url) (message "Toot URL copied to the clipboard."))) -;; TODO redraw buffer on success? (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." (interactive) @@ -231,6 +231,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((response (mastodon-http--delete url))) (mastodon-http--triage response (lambda () + (mastodon-tl--reload-timeline-or-profile) (message "Toot deleted!")))))))) (defun mastodon-toot--kill () -- cgit v1.2.3 From 21c6572d62d9129b48003129e60c97d0f64868d0 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 23 Sep 2021 11:42:14 +0200 Subject: hacks to minimize toot bug: copy text, only kill buffer after post --- lisp/mastodon-toot.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d86eefd..1c8a475 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -301,10 +301,12 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (message "Looks like your uploads are not yet ready...") (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") - (mastodon-toot--kill) - (let ((response (mastodon-http--post endpoint args nil))) + (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response - (lambda () (message "Toot toot!")))))))) + (lambda () + (kill-new toot) ; copy toot text to kill ring + (mastodon-toot--kill) ; only kill buffer after sending + (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) "Adds domain to local ACCT and replaces the curent user name with \"\". -- cgit v1.2.3 From 4499e9471c4a7ba923ef950954a9e42f9a7ed6e9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 23 Sep 2021 13:09:17 +0200 Subject: basic delete-and-redraft-toot, text status only for now. --- lisp/mastodon-toot.el | 25 +++++++++++++++++++++++++ lisp/mastodon.el | 2 ++ 2 files changed, 27 insertions(+) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1c8a475..1f65cbf 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -234,6 +234,31 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (mastodon-tl--reload-timeline-or-profile) (message "Toot deleted!")))))))) +;; TODO: handle media/poll for redrafting toots +(defun mastodon-toot--delete-and-redraft-toot () + "Delete and redraft user's toot at point synchronously." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (url (mastodon-http--api (format "statuses/%s" id)))) + (if (or (cdr (assoc 'reblog toot)) + (not (equal (cdr (assoc 'acct + (cdr (assoc 'account toot)))) + (mastodon-auth--user-acct)))) + (message "You can only delete and redraft your own toots.") + (if (y-or-n-p (format "Delete and redraft this toot? ")) + (let* ((response (mastodon-http--delete url))) + (mastodon-http--triage + response + (lambda () + (with-current-buffer response + (let* ((json-response (mastodon-http--process-json)) + (content (cdr (assoc 'text json-response))) + (media (cdr (assoc 'media_attachments json-response)))) + (mastodon-toot--compose-buffer nil nil) + (goto-char (point-max)) + (insert content)))))))))) + (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window." (kill-buffer-and-window)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 460fe29..acb9e12 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -80,6 +80,7 @@ (autoload 'mastodon-profile--update-user-profile-note "mastodon-profile") (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-tl--poll-vote "mastodon-http") +(autoload 'mastodon-toot--delete-and-redraft-toot "mastodon-toot") (defgroup mastodon nil "Interface with Mastodon." @@ -143,6 +144,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "C-S-P") #'mastodon-profile--my-profile) (define-key map (kbd "S") #'mastodon-search--search-query) (define-key map (kbd "d") #'mastodon-toot--delete-toot) + (define-key map (kbd "D") #'mastodon-toot--delete-and-redraft-toot) (define-key map (kbd "C") #'mastodon-toot--copy-toot-url) (define-key map (kbd "i") #'mastodon-toot--pin-toot-toggle) (define-key map (kbd "V") #'mastodon-profile--view-favourites) -- cgit v1.2.3 From d1458ad0c1bf95a685a3b9ff3e4750ce82305d7a Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 23 Sep 2021 13:18:44 +0200 Subject: fix formatting of mastodon-toot-default-visibility --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1f65cbf..97841b5 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -58,10 +58,11 @@ Must be one of \"public\", \"unlisted\", \"private\", or \"direct\"." :group 'mastodon-toot - :type '(choice ("public" - "unlisted" - "private" - "direct"))) + :type 'choice + :options '("public" + "unlisted" + "private" + "direct")) (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") -- cgit v1.2.3 From 6b7d03538afb6679d9f614d861743e2b0150c191 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 23 Sep 2021 14:19:36 +0200 Subject: display "followers-only" for "private" post visibility --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 97841b5..95f562c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -56,7 +56,7 @@ (defcustom mastodon-toot--default-visibility "public" "The default visibility for new toots. -Must be one of \"public\", \"unlisted\", \"private\", or \"direct\"." +Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \"direct\"." :group 'mastodon-toot :type 'choice :options '("public" @@ -75,7 +75,7 @@ Must be one of \"public\", \"unlisted\", \"private\", or \"direct\"." (defvar mastodon-toot--visibility "public" "A string indicating the visibility of the toot being composed. -Valid values are \"direct\", \"private\", \"unlisted\", and \"public\".") +Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\".") (make-variable-buffer-local 'mastodon-toot--visibility) (defvar mastodon-toot--media-attachments nil @@ -520,7 +520,11 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display (format "Visibility: %s" - mastodon-toot--visibility))) + (if (equal + mastodon-toot--visibility + "private") + "followers-only" + mastodon-toot--visibility)))) (add-text-properties (car attachment-region) (cdr attachment-region) (list 'display (format "Attached: %s" -- cgit v1.2.3 From 77f0d464c39693ffef7146aced2804e787a870de Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 2 Oct 2021 00:27:24 +0200 Subject: repair somewhat the media-upload functions and error handling --- lisp/mastodon-http.el | 26 +++++++++++++------------- lisp/mastodon-toot.el | 6 +----- 2 files changed, 14 insertions(+), 18 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 31ea483..cd89cc5 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -249,11 +249,11 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (defun mastodon-http--post-media-attachment (url filename caption) "Make POST request to upload FILENAME with CAPTION to the server's media URL. -The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' is set to the id(s) of the item uploaded, `mastodon-toot--media-attachments' is set to t, and `mastodon-toot--update-status-fields' is run." +The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' is set to the id(s) of the item uploaded, and `mastodon-toot--update-status-fields' is run." (let* ((file (file-name-nondirectory filename)) - (request-backend 'curl) - (response - (request + (request-backend 'curl)) + ;; (response + (request url :type "POST" :params `(("description" . ,caption)) @@ -278,15 +278,15 @@ The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' (mastodon-toot--update-status-fields))))) :error (cl-function (lambda (&key error-thrown &allow-other-keys) - (message "Got error: %s" error-thrown)))))) - (pcase (request-response-status-code response) - (200 - (request-response-data response)) - (401 - (error "Unauthorized: The access token is invalid")) - (422 - (error "Unprocessable entity: file or file type is unsupported or invalid")) - (_ (error "Shit went south"))))) + (message "%s" (car (last error-thrown))) + (message "%s" (type-of (car (last error-thrown)))) + (cond ((= (car (last error-thrown)) 401) + (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) + ((= (car (last error-thrown)) 422) + (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown)) + (t + (message "Got error: %s Shit went south" + error-thrown)))))))) (provide 'mastodon-http) ;;; mastodon-http.el ends here diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 95f562c..0c3c784 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -78,10 +78,6 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\".") (make-variable-buffer-local 'mastodon-toot--visibility) -(defvar mastodon-toot--media-attachments nil - "A flag indicating if the toot being composed has media attachments.") -(make-variable-buffer-local 'mastodon-toot--media-attachments) - (defvar mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") (make-variable-buffer-local 'mastodon-toot--media-attachment-ids) @@ -316,7 +312,7 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media - (when mastodon-toot--media-attachments + (when mastodon-toot--media-attachment-ids (mapcar (lambda (id) (cons "media_ids[]" id)) -- cgit v1.2.3 From a311de00bd4fb2ad467c955e1fa12fd5613b58b2 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 2 Oct 2021 00:27:57 +0200 Subject: add emojify-insert-emoji binding in mastodon new toot buffer --- lisp/mastodon-toot.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0c3c784..fc8949a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -31,6 +31,8 @@ (defvar mastodon-instance-url) +(declare-function #'emojify-insert-emoji "emojify") + (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") @@ -98,6 +100,8 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) (define-key map (kbd "C-c C-a") #'mastodon-toot--add-media-attachment) + (when (require 'emojify nil :noerror) + (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) map) "Keymap for `mastodon-toot'.") @@ -265,6 +269,10 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (interactive) (mastodon-toot--kill)) +(defun mastodon-toot--insert-emoji () + "Prompt to insert an emoji." + (emojify-insert-emoji)) + (defun mastodon-toot--remove-docs () "Get the body of a toot from the current compose buffer." (let ((header-region (mastodon-tl--find-property-range 'toot-post-header -- cgit v1.2.3 From d13fa5fb1a4f41db6c97927776c79194f7bc9da6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 2 Oct 2021 13:15:58 +0200 Subject: flycheck: docstrings, autoloads, declarations --- lisp/mastodon-http.el | 6 +++- lisp/mastodon-search.el | 3 +- lisp/mastodon-tl.el | 96 ++++++++++++++++++++++++++++++++----------------- lisp/mastodon-toot.el | 14 ++++---- 4 files changed, 78 insertions(+), 41 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index cd89cc5..abd9af0 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -191,7 +191,9 @@ Pass response buffer to CALLBACK function." ;; hard coded just for bio note for now: (defun mastodon-http--patch (base-url &optional note) - "Make synchronous PATCH request to URL. + "Make synchronous PATCH request to BASE-URL. + +Optionally specify the NOTE to edit. Pass response buffer to CALLBACK function." (let ((url-request-method "PATCH") @@ -228,6 +230,8 @@ Pass response buffer to CALLBACK function with args CBARGS." (defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) "POST asynchronously to URL with ARGS and HEADERS. +Then run function CALLBACK with arguements CBARGS. + Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (let ((url-request-method "POST") (request-timeout 5) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 3b7e399..537a746 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -41,8 +41,7 @@ (defvar mastodon-instance-url) (defvar mastodon-tl--link-keymap) - -(defconst mastodon-http--timeout 5) +(defvar mastodon-http--timeout) (defun mastodon-search--search-query (query) "Prompt for a search QUERY and return accounts, statuses, and hashtags." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index da18a94..48237d9 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -33,6 +33,7 @@ (require 'thingatpt) ;; for word-at-point (require 'time-date) +(autoload 'mastodon-auth--get-account-name "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-media--get-avatar-rendering "mastodon-media") @@ -53,10 +54,13 @@ (autoload 'mastodon-http--get-json-async "mastodon-http") (autoload 'mastodon-profile--lookup-account-in-status "mastodon-profile") (autoload 'mastodon-profile-mode "mastodon-profile") +(autoload 'mastodon-notifications--get "mastodon-notifications") (defvar mastodon-instance-url) (defvar mastodon-toot-timestamp-format) (defvar shr-use-fonts) ;; declare it since Emacs24 didn't have this +(declare-function mapcar* "cl") + (defgroup mastodon-tl nil "Timelines in Mastodon." :prefix "mastodon-tl-" @@ -116,7 +120,7 @@ If nil `(point-min)' is used instead.") (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). + "The keymap for link-like things in buffer (except for shr.el generate links). This will make the region of text act like like a link with mouse highlighting, mouse click action tabbing to next/previous link @@ -175,9 +179,10 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (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." +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))) @@ -310,7 +315,7 @@ Return value from boosted content if available." (cdr (assoc field toot)))) (defun mastodon-tl--relative-time-details (timestamp &optional current-time) - "Returns cons of (descriptive string . next change) for the TIMESTAMP. + "Return cons of (descriptive string . next change) for the TIMESTAMP. Use the optional CURRENT-TIME as the current time (only used for reliable testing). @@ -365,7 +370,7 @@ TIMESTAMP is assumed to be in the past." (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 TIMESTAMP relative to the current time. + "Return a string with a human readable TIMESTAMP relative to the current time. Use the optional CURRENT-TIME as the current time (only used for reliable testing). @@ -380,8 +385,8 @@ TIME-STAMP is assumed to be in the past." 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'" +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)))) @@ -411,7 +416,7 @@ it is `mastodon-tl--byline-boosted'" 'byline t)))) (defun mastodon-tl--render-text (string toot) - "Returns a propertized text giving the rendering of the given HTML string STRING. + "Return a propertized text rendering the given HTML string STRING. The contents comes from the given TOOT which is used in parsing links in the text. If TOOT is nil no parsing occurs." @@ -433,6 +438,8 @@ links in the text. If TOOT is nil no parsing occurs." (buffer-string))) (defun mastodon-tl--process-link (toot start end url) + "Process link URL in TOOT as hashtag, userhandle, or normal link. +START and END are the boundaries of the link in the toot." (let* (mastodon-tab-stop-type keymap (help-echo (get-text-property start 'help-echo)) @@ -499,7 +506,7 @@ links in the text. If TOOT is nil no parsing occurs." 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. + "Return the user hande the URL points to or nil if it is not a profile link. BUFFER-TEXT is the text covered by the link with URL, for a user profile this should be of the form , e.g. \"@Gargon\"." @@ -510,7 +517,7 @@ this should be of the form , e.g. \"@Gargon\"." (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. + "Return the hashtag that URL points to or nil if URL is not a tag link. INSTANCE-URL is the url of the instance for the toot that the link came from (tag links always point to a page on the instance publishing @@ -526,7 +533,7 @@ the toot)." (t nil))) (defun mastodon-tl--set-face (string face) - "Returns the propertized STRING with the face property set to FACE." + "Return the propertized STRING with the face property set to FACE." (propertize string 'face face)) (defun mastodon-tl--toggle-spoiler-text (position) @@ -568,7 +575,7 @@ LINK-TYPE is the type of link to produce." ((eq link-type 'content-warning) "Toggle hidden text") (t - (error "unknown link type %s" link-type))))) + (error "Unknown link type %s" link-type))))) (propertize string 'mastodon-tab-stop link-type @@ -577,7 +584,8 @@ LINK-TYPE is the type of link to produce." 'help-echo help-text))) (defun mastodon-tl--do-link-action-at-point (position) - ;; called by RET + "Do the action of the link at POSITION. +Used for hitting on a given link." (interactive "d") (let ((link-type (get-text-property position 'mastodon-tab-stop))) (cond ((eq link-type 'content-warning) @@ -601,10 +609,11 @@ LINK-TYPE is the type of link to produce." (mastodon-profile--search-account-by-handle (get-text-property position 'mastodon-handle))))))) (t - (error "unknown link type %s" link-type))))) + (error "Unknown link type %s" link-type))))) (defun mastodon-tl--do-link-action (event) - ;; called by mouse click + "Do the action of the link at. +Used for a mouse-click EVENT on a link." (interactive "e") (mastodon-tl--do-link-action-at-point (posn-point (event-end event)))) @@ -614,6 +623,7 @@ LINK-TYPE is the type of link to produce." (and spoiler (> (length spoiler) 0)))) (defun mastodon-tl--clean-tabs-and-nl (string) + "Remove tabs and newlines from STRING." (replace-regexp-in-string "[\t\n ]*\\'" "" string)) @@ -683,11 +693,13 @@ message is a link which unhides/hides the main body." "Display the content and byline of timeline element TOOT. BODY will form the section of the toot above the byline. -AUTHOR-BYLINE is an optional function for adding the author portion of -the byline that takes one variable. By default it is `mastodon-tl--byline-author' -ACTION-BYLINE is 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'" +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 @@ -782,23 +794,26 @@ it is `mastodon-tl--byline-boosted'" (goto-char (point-min))) (defun mastodon-tl--get-update-function (&optional buffer) - "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'" + "Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'. +Optionally get it for BUFFER." (mastodon-tl--get-buffer-property 'update-function buffer)) (defun mastodon-tl--get-endpoint (&optional buffer) - "Get the ENDPOINT stored in `mastodon-tl--buffer-spec'" + "Get the ENDPOINT stored in `mastodon-tl--buffer-spec'. +Optionally set it for BUFFER." (mastodon-tl--get-buffer-property 'endpoint buffer)) (defun mastodon-tl--buffer-name (&optional buffer) - "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'" + "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. +Optionally get it for BUFFER." (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'" + "Get PROPERTY from `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" + (error "Mastodon-tl--buffer-spec is not defined for buffer %s" (or buffer (current-buffer)))))) (defun mastodon-tl--more-json (endpoint id) @@ -813,7 +828,8 @@ it is `mastodon-tl--byline-boosted'" (mastodon-http--get-json url))) (defun mastodon-tl--more-json-async (endpoint id callback &rest cbargs) - "Return JSON for timeline ENDPOINT before ID." + "Return JSON for timeline ENDPOINT before ID. +Then run CALLBACK with arguments CBARGS." (let* ((url (mastodon-http--api (concat endpoint (if (string-match-p "?" endpoint) @@ -891,6 +907,11 @@ webapp" 'mastodon-tl--thread* id toot buffer))) (defun mastodon-tl--thread* (context id toot buffer) + "Callback for async `mastodon-tl--thread'. + +Open thread buffer for TOOT with id ID under `point'asynchronously, +in new BUFFER. +CONTEXT is the previous and subsequent toots in the thread." (when (member (cdr (assoc 'type toot)) '("reblog" "favourite")) (setq toot (cdr (assoc 'status toot)))) (if (> (+ (length (cdr (assoc 'ancestors context))) @@ -1054,6 +1075,7 @@ webapp" (message "User %s (@%s) unblocked!" name user-handle))))) (message "Cannot find a user with handle %S" user-handle)))) +;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () "Reload the current timeline or profile page. For use after e.g. deleting a toot." @@ -1070,12 +1092,15 @@ For use after e.g. deleting a toot." (mastodon-profile--my-profile)))) (defun mastodon-tl--more () - "Append older toots to timeline." + "Append older toots to timeline, asynchronously." (interactive) (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) 'mastodon-tl--more* (current-buffer) (point))) (defun mastodon-tl--more* (json buffer point-before) + "Append older toots to timeline, asynchronously. +Runs the timeline's update function on JSON, in BUFFER. +When done, places point at POINT-BEFORE." (with-current-buffer buffer (when json (let ((inhibit-read-only t)) @@ -1084,7 +1109,7 @@ For use after e.g. deleting a toot." (goto-char point-before))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) - "Returns `nil` if no such range is found. + "Return `nil` if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. @@ -1120,9 +1145,12 @@ before (non-nil) or after (nil)" (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). + "Find (start . end) property range after/before START-POINT. + +Does so while PROPERTY is set to a consistent value (different +from the value at START-POINT if that is set). -Returns nil if no such range exists. +Return nil if no such range exists. If SEARCH-BACKWARDS is non-nil it find a region before START-POINT otherwise after START-POINT." @@ -1237,7 +1265,7 @@ from the start if it is nil." (funcall update-function json))))) (defun mastodon-tl--init (buffer-name endpoint update-function) - "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. + "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. UPDATE-FUNCTION is used to recieve more toots." (let ((url (mastodon-http--api endpoint)) @@ -1246,6 +1274,10 @@ UPDATE-FUNCTION is used to recieve more toots." url 'mastodon-tl--init* buffer endpoint update-function))) (defun mastodon-tl--init* (json buffer endpoint update-function) + "Initialize BUFFER with timeline targeted by ENDPOINT. + +UPDATE-FUNCTION is used to recieve more toots. +JSON is the data returned from the server." (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (setq diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index fc8949a..9fb31d1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -31,13 +31,15 @@ (defvar mastodon-instance-url) -(declare-function #'emojify-insert-emoji "emojify") +(when (require 'emojify nil :noerror) + (declare-function emojify-insert-emoji "emojify")) (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-http--delete "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") @@ -254,8 +256,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (lambda () (with-current-buffer response (let* ((json-response (mastodon-http--process-json)) - (content (cdr (assoc 'text json-response))) - (media (cdr (assoc 'media_attachments json-response)))) + (content (cdr (assoc 'text json-response)))) + ;; (media (cdr (assoc 'media_attachments json-response)))) (mastodon-toot--compose-buffer nil nil) (goto-char (point-max)) (insert content)))))))))) @@ -280,7 +282,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (buffer-substring (cdr header-region) (point-max)))) (defun mastodon-toot--set-visibility (visibility) - "Sets the visiblity of the next toot to VISIBILITY." + "Set the visiblity of the next toot to VISIBILITY." (interactive (list (completing-read "Visiblity: " '("public" "unlisted" @@ -339,7 +341,7 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) - "Adds domain to local ACCT and replaces the curent user name with \"\". + "Add domain to local ACCT and replace the curent user name with \"\". Mastodon requires the full user@domain, even in the case of local accts. eg. \"user\" -> \"user@local.social \" (when local.social is the domain of the @@ -502,7 +504,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (insert (format "%s " reply-to-user)) (setq mastodon-toot--reply-to-id reply-to-id))) -(defun mastodon-toot--update-status-fields (&rest args) +(defun mastodon-toot--update-status-fields () ;(&rest args) "Update the status fields in the header based on the current state." (let ((inhibit-read-only t) (header-region (mastodon-tl--find-property-range 'toot-post-header -- cgit v1.2.3 From 3ab777cd650825c525c469ce640204064fca7692 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 2 Oct 2021 13:16:25 +0200 Subject: customize option default-media-directory --- lisp/mastodon-toot.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9fb31d1..17b3a6c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -68,6 +68,11 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" "private" "direct")) +(defcustom mastodon-toot--default-media-directory "~/" + "The default directory when prompting for a media file to upload." + :group 'mastodon-toot + :type 'string) + (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) @@ -296,7 +301,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." Set `mastodon-toot--media-attachment-ids' to the item's id so it can be attached to the toot." (interactive) - (let* ((filename (read-file-name "Choose file to attach to this toot: ")) + (let* ((filename (read-file-name "Choose file to attach to this toot: " + mastodon-toot--default-media-directory)) (caption (read-string "Enter a caption: ")) (url (concat mastodon-instance-url "/api/v1/media"))) (message "Uploading %s..." (file-name-nondirectory filename)) -- cgit v1.2.3 From 0be3f27b8e97b4e765fc67dfc4b6c0a107d685bd Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 2 Oct 2021 13:16:54 +0200 Subject: restore var toot--media-attachments --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 17b3a6c..dfe9ead 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -87,6 +87,10 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\".") (make-variable-buffer-local 'mastodon-toot--visibility) +(defvar mastodon-toot--media-attachments nil + "A flag indicating if the toot being composed has media attachments.") +(make-variable-buffer-local 'mastodon-toot--media-attachments) + (defvar mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") (make-variable-buffer-local 'mastodon-toot--media-attachment-ids) @@ -469,9 +473,9 @@ e.g. mastodon-toot--send -> Send." (mastodon-toot--format-kbinds kbinds)))) (defun mastodon-toot--display-docs-and-status-fields () - "Insert propertized text with documentation about mastodon-toot mode and the -status fields which will get updated based on the status of NSFW, content -warning flags etc." + "Insert propertized text with documentation about `mastodon-toot-mode'. +Also includes and the status fields which will get updated based +on the status of NSFW, content warning flags, media attachments, etc." (let ((divider "|=================================================================|")) (insert -- cgit v1.2.3 From 8477f3aa37f2145a16e6aa627de92844094c2453 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sun, 3 Oct 2021 20:33:56 +0200 Subject: make mastodon-toot--insert-emoji an alias --- lisp/mastodon-toot.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index dfe9ead..c28bcb1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -280,9 +280,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (interactive) (mastodon-toot--kill)) -(defun mastodon-toot--insert-emoji () - "Prompt to insert an emoji." - (emojify-insert-emoji)) +(defalias 'mastodon-toot--insert-emoji + 'emojify-insert-emoji + "Prompt to insert an emoji.") (defun mastodon-toot--remove-docs () "Get the body of a toot from the current compose buffer." -- cgit v1.2.3 From 26d0c9af7e9154e2ba1e9fbc0322d3679d07f4f1 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Thu, 21 Feb 2019 20:15:07 +0000 Subject: Fix: make after-change-functions buffer local. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit See issue #218 — we mistakenly modified the global value and `mastodon-toot--update-status-fields` makes no sense outside the toot compose buffer. --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c28bcb1..16eae12 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -514,7 +514,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (insert (format "%s " reply-to-user)) (setq mastodon-toot--reply-to-id reply-to-id))) -(defun mastodon-toot--update-status-fields () ;(&rest args) +(defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." (let ((inhibit-read-only t) (header-region (mastodon-tl--find-property-range 'toot-post-header @@ -566,6 +566,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) + (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--update-status-fields))) -- cgit v1.2.3 From 998c27982cb96ccadd86b987f8e7e02ee517f1cf Mon Sep 17 00:00:00 2001 From: mousebot Date: Sun, 3 Oct 2021 20:40:32 +0200 Subject: revert bug workaround copying toot to kill ring --- lisp/mastodon-toot.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 16eae12..a8b121b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -346,8 +346,7 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () - (kill-new toot) ; copy toot text to kill ring - (mastodon-toot--kill) ; only kill buffer after sending + (mastodon-toot--kill) (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) -- cgit v1.2.3 From 1f2ebe94c647fef509e06e9ef6f79697ef98a356 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 12:57:41 +0200 Subject: first test merge of hdurer's WIP: Posting of images --- lisp/mastodon-auth.el | 30 +++++------ lisp/mastodon-client.el | 8 +-- lisp/mastodon-http.el | 64 +++++++++++++++++++---- lisp/mastodon-media.el | 5 ++ lisp/mastodon-toot.el | 133 +++++++++++++++++++++++++++++++++++------------- 5 files changed, 176 insertions(+), 64 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 0b0c703..cd74ef8 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -73,12 +73,12 @@ If no auth-sources file, runs `mastodon-auth--generate-token-no-storing-credenti "Make POST to generate auth token, without using auth-sources file." (mastodon-http--post (concat mastodon-instance-url "/oauth/token") - `(("client_id" . ,(plist-get (mastodon-client) :client_id)) - ("client_secret" . ,(plist-get (mastodon-client) :client_secret)) - ("grant_type" . "password") - ("username" . ,(read-string "Email: " user-mail-address)) - ("password" . ,(read-passwd "Password: ")) - ("scope" . "read write follow")) + `(("client_id" ,(plist-get (mastodon-client) :client_id)) + ("client_secret" ,(plist-get (mastodon-client) :client_secret)) + ("grant_type" "password") + ("username" ,(read-string "Email: " user-mail-address)) + ("password" ,(read-passwd "Password: ")) + ("scope" "read write follow")) nil :unauthenticated)) @@ -98,15 +98,15 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." (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")) + `(("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)) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index bdfbca9..4503d6d 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -49,10 +49,10 @@ "POST client to Mastodon." (mastodon-http--post (mastodon-http--api "apps") - '(("client_name" . "mastodon.el") - ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") - ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) + '(("client_name" "mastodon.el") + ("redirect_uris" "urn:ietf:wg:oauth:2.0:oob") + ("scopes" "read write follow") + ("website" "https://github.com/jdenen/mastodon.el")) nil :unauthenticated)) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index bc48e8d..85ee588 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -90,29 +90,75 @@ Message status and JSON error from RESPONSE if unsuccessful." (let ((json-response (mastodon-http--process-json))) (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) +(defun mastodon-http--encode-multipart-form-data (boundary fields) + "Encode FIELDS suitable to post as multipart/form-data. + +It uses BOUNDARY as the boundary for the values. +FIELDS should be a list of either 2-element (name contents) lists +or 4-element list of (name file-name content-type contents)." + (with-temp-buffer + (dolist (field fields) + (insert "--" boundary "\r\n") + (if (= (length field) 2) + ;; a 2-element list is a simple name=value item: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"\r\n" + "\r\n" + (cadr field) "\r\n") + ;; a 4-element list ist a file to be attached: + (insert "Content-Disposition: form-data; name=\"" + (url-hexify-string (car field)) + "\"; filename=\"" + (url-hexify-string (cadr field)) + "\"\r\n" + "Content-type: " (caddr field) "\r\n" + "\r\n" + (cadddr field) "\r\n"))) + ;; Finally add the terminating boundary and another empty line: + (insert "--" boundary "--\r\n" + "\r\n") + (string-to-unibyte (buffer-string)))) + (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 - "&"))) + (let* ((url-request-method "POST") + (boundary (md5 (format "b%s-%s-%s-%s" + (random 1000000000) (random 1000000000) + (random 1000000000) (random 1000000000)))) + (needs-multi-form (> (apply #'max (mapcar #'length args)) 2)) + (url-request-data + (when args + (if needs-multi-form + (mastodon-http--encode-multipart-form-data boundary args) + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cadr arg)))) + args + "&")))) (url-request-extra-headers (append + (when needs-multi-form + `(("Content-Type" . + ,(concat "multipart/form-data; boundary=\"" boundary "\"")))) (unless unauthenticed-p `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) headers))) + (message "Posting to %s with %d bytes of request data and headers %s" url (length url-request-data) url-request-extra-headers) (with-temp-buffer (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) (url-retrieve-synchronously url) (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) +(defun mastodon-http--read-file-as-string (filename) + "" + (with-temp-buffer + (insert-file-contents filename) + (string-to-unibyte (buffer-string)))) + (defun mastodon-http--get (url) "Make synchronous GET request to URL. diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 8aadf0a..fd2a6b7 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -51,6 +51,11 @@ :group 'mastodon-media :type 'integer) +(defcustom mastodon-media--attachment-height 100 + "Height of the attached images preview." + :group 'mastodon-media + :type 'integer) + (defvar mastodon-media--generic-avatar-data (base64-decode-string "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a8b121b..6c08859 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -30,6 +30,7 @@ ;;; Code: (defvar mastodon-instance-url) +(defvar mastodon-media--attachment-height) (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) @@ -103,6 +104,10 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p "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--media-attachments nil + "Buffer-local variable to hold the list of media attachments.") +(make-variable-buffer-local 'mastodon-toot--media-attachments) + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -110,9 +115,10 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (define-key map (kbd "C-c C-w") #'mastodon-toot--toggle-warning) (define-key map (kbd "C-c C-n") #'mastodon-toot--toggle-nsfw) (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) - (define-key map (kbd "C-c C-a") #'mastodon-toot--add-media-attachment) (when (require 'emojify nil :noerror) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) + (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) + (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) map) "Keymap for `mastodon-toot'.") @@ -147,6 +153,14 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) +(defun mastodon-toot--post-media (contents content-type description) + (let* ((url (mastodon-http--api "media")) + (response (mastodon-http--post + url + (list (list "description" description) + (list "file" "file" content-type contents))))) + response)) + (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." (interactive) @@ -414,6 +428,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (interactive) (setq mastodon-toot--content-nsfw (not mastodon-toot--content-nsfw)) + (message "NSFW flag is now %s" (if mastodon-toot--content-nsfw "on" "off")) (mastodon-toot--update-status-fields)) (defun mastodon-toot--change-visibility () @@ -430,6 +445,54 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." "public"))) (mastodon-toot--update-status-fields)) +(defun mastodon-toot--clear-all-attachments () + "" + (interactive) + (setq mastodon-toot--media-attachments nil) + (mastodon-toot--refresh-attachments-display) + (mastodon-toot--update-status-fields)) + +(defun mastodon-toot--attach-media (file content-type description) + "" + (interactive "fFilename: \nsContent type: \nsDescription: ") + (when (>= (length mastodon-toot--media-attachments) 4) + ;; Only a max. of 4 attachments are allowed, so pop the oldest one. + (pop mastodon-toot--media-attachments)) + (setq mastodon-toot--media-attachments + (nconc mastodon-toot--media-attachments + `(((:contents . ,(mastodon-http--read-file-as-string file)) + (:content-type . ,content-type) + (:description . ,description))))) + (mastodon-toot--refresh-attachments-display)) + +(defun mastodon-toot--refresh-attachments-display () + (let ((inhibit-read-only t) + (attachments-region (mastodon-tl--find-property-range + 'toot-attachments (point-min))) + (display-specs (mastodon-toot--format-attachments))) + (dotimes (i (- (cdr attachments-region) (car attachments-region))) + (add-text-properties (+ (car attachments-region) i) + (+ (car attachments-region) i 1) + (list 'display (or (nth i display-specs) "")))))) + +(defun mastodon-toot--format-attachments () + (or (let ((counter 0) + (image-options (when (image-type-available-p 'imagemagick) + `(:height ,mastodon-media--attachment-height)))) + (mapcan (lambda (attachment) + (let* ((data (cdr (assoc :contents attachment))) + (image (apply #'create-image data + (when image-options 'imagemagick) + t image-options)) + (type (cdr (assoc :content-type attachment))) + (description (cdr (assoc :description attachment)))) + (setq counter (1+ counter)) + (list (format "\n %d: " counter) + image + (format " \"%s\" (%s)" description type)))) + mastodon-toot--media-attachments)) + (list "None")) + ) ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -483,6 +546,10 @@ on the status of NSFW, content warning flags, media attachments, etc." divider "\n" (mastodon-toot--make-mode-docs) "\n" divider "\n" + " Attachments: " + (propertize "None " 'toot-attachments t) + "\n" + divider "\n" " " (propertize "Count" 'toot-post-counter t) @@ -515,43 +582,35 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." - (let ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'toot-post-header + (ignore-errors ;; called from after-change-functions so let's not leak errors + (let ((inhibit-read-only t) + (header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'toot-post-counter (point-min))) - (count-region (mastodon-tl--find-property-range 'toot-post-counter + (visibility-region (mastodon-tl--find-property-range + 'toot-post-visibility (point-min))) + (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag (point-min))) - (visibility-region (mastodon-tl--find-property-range - 'toot-post-visibility (point-min))) - (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag - (point-min))) - (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag - (point-min))) - (attachment-region (mastodon-tl--find-property-range - 'toot-attachment (point-min)))) - (add-text-properties (car count-region) (cdr count-region) - (list 'display - (format "%s characters" - (- (point-max) (cdr header-region))))) - (add-text-properties (car visibility-region) (cdr visibility-region) - (list 'display - (format "Visibility: %s" - (if (equal - mastodon-toot--visibility - "private") - "followers-only" - mastodon-toot--visibility)))) - (add-text-properties (car attachment-region) (cdr attachment-region) - (list 'display - (format "Attached: %s" - (mapconcat 'identity - mastodon-toot--media-attachment-filenames - ", ")))) - (add-text-properties (car nsfw-region) (cdr nsfw-region) - (list 'invisible (not mastodon-toot--content-nsfw) - 'face 'mastodon-cw-face)) - (add-text-properties (car cw-region) (cdr cw-region) - (list 'invisible (not mastodon-toot--content-warning) - 'face 'mastodon-cw-face)))) + (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag + (point-min)))) + (add-text-properties (car count-region) (cdr count-region) + (list 'display + (format "%s characters in message" + (- (point-max) (cdr header-region))))) + (add-text-properties (car visibility-region) (cdr visibility-region) + (list 'display + (format "Visibility: %s" + mastodon-toot--visibility))) + (add-text-properties (car nsfw-region) (cdr nsfw-region) + (list 'display (if mastodon-toot--content-nsfw + (if mastodon-toot--media-attachments + "NSFW" "NSFW (no effect until attachments added)") + "") + 'face 'mastodon-cw-face)) + (add-text-properties (car cw-region) (cdr cw-region) + (list 'invisible (not mastodon-toot--content-warning) + 'face 'mastodon-cw-face))))) (defun mastodon-toot--compose-buffer (reply-to-user reply-to-id) "Create a new buffer to capture text for a new toot. @@ -561,12 +620,14 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (buffer (or buffer-exists (get-buffer-create "*new toot*"))) (inhibit-read-only t)) (switch-to-buffer-other-window buffer) + (mastodon-toot-mode t) (when (not buffer-exists) (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) + (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields))) (define-minor-mode mastodon-toot-mode -- cgit v1.2.3 From 72c14d797fe3848429b64812fb7145d11253fc88 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 13:13:38 +0200 Subject: handle image scaling with image-transforms-p (when emacs >= 27.1) --- lisp/mastodon-toot.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6c08859..1afad8a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -477,12 +477,15 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--format-attachments () (or (let ((counter 0) - (image-options (when (image-type-available-p 'imagemagick) + (image-options (when (or (image-type-available-p 'imagemagick) + (image-transforms-p)) `(:height ,mastodon-media--attachment-height)))) (mapcan (lambda (attachment) (let* ((data (cdr (assoc :contents attachment))) (image (apply #'create-image data - (when image-options 'imagemagick) + (if (version< emacs-version "27.1") + (when image-options 'imagemagick) + nil) ; inbuilt scaling in 27.1 t image-options)) (type (cdr (assoc :content-type attachment))) (description (cdr (assoc :description attachment)))) @@ -491,8 +494,8 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." image (format " \"%s\" (%s)" description type)))) mastodon-toot--media-attachments)) - (list "None")) - ) + (list "None"))) + ;; we'll need to revisit this if the binds get ;; more diverse than two-chord bindings (defun mastodon-toot--get-mode-kbinds () @@ -596,7 +599,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (point-min)))) (add-text-properties (car count-region) (cdr count-region) (list 'display - (format "%s characters in message" + (format "%s characters" (- (point-max) (cdr header-region))))) (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display -- cgit v1.2.3 From 13064aa96e0152da0dfbe93e5349aaef61646731 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 14:51:32 +0200 Subject: revert "private" visibility = "followers only" in toot draft --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 1afad8a..5b7d537 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -602,9 +602,13 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (format "%s characters" (- (point-max) (cdr header-region))))) (add-text-properties (car visibility-region) (cdr visibility-region) - (list 'display - (format "Visibility: %s" - mastodon-toot--visibility))) + (list 'display + (format "Visibility: %s" + (if (equal + mastodon-toot--visibility + "private") + "followers-only" + mastodon-toot--visibility)))) (add-text-properties (car nsfw-region) (cdr nsfw-region) (list 'display (if mastodon-toot--content-nsfw (if mastodon-toot--media-attachments -- cgit v1.2.3 From 6b2207251c9b44cd47cc03c8f9a68970e123c5d6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:00:21 +0200 Subject: merge hdurers attachment upload and my own replace hdurer's mastodon-toot--post-media and my mastodon-toot--add-media-attachment with hdurer's mastodon-toot--attach-media (which holds the data in the toot draft) and my mastodon-toot--upload-media-attachments (which actually uploads them) --- lisp/mastodon-toot.el | 48 +++++++++++++++++++++--------------------------- 1 file changed, 21 insertions(+), 27 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5b7d537..7407a7c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -89,7 +89,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (make-variable-buffer-local 'mastodon-toot--visibility) (defvar mastodon-toot--media-attachments nil - "A flag indicating if the toot being composed has media attachments.") + "A list of the media attachments of the toot being composed .") (make-variable-buffer-local 'mastodon-toot--media-attachments) (defvar mastodon-toot--media-attachment-ids nil @@ -153,14 +153,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) -(defun mastodon-toot--post-media (contents content-type description) - (let* ((url (mastodon-http--api "media")) - (response (mastodon-http--post - url - (list (list "description" description) - (list "file" "file" content-type contents))))) - response)) - (defun mastodon-toot--toggle-boost () "Boost/unboost toot at `point'." (interactive) @@ -314,19 +306,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (setq mastodon-toot--visibility visibility) (message "Visibility set to %s" visibility)) -(defun mastodon-toot--add-media-attachment () - "Prompt the user for a file and POST it to the media endpoint on the server. - -Set `mastodon-toot--media-attachment-ids' to the item's id so it can be attached to the toot." - (interactive) - (let* ((filename (read-file-name "Choose file to attach to this toot: " - mastodon-toot--default-media-directory)) - (caption (read-string "Enter a caption: ")) - (url (concat mastodon-instance-url "/api/v1/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) - (mastodon-http--post-media-attachment url filename caption) - (setq mastodon-toot--media-attachments t))) - (defun mastodon-toot--send () "Kill new-toot buffer/window and POST contents to the Mastodon instance. @@ -357,11 +336,11 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (message "Looks like your uploads are not yet ready...") (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") - (let ((response (mastodon-http--post endpoint args nil))) + (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!")))))))) + (message "Toot toot!"))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -446,14 +425,16 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (mastodon-toot--update-status-fields)) (defun mastodon-toot--clear-all-attachments () - "" + "Remove all attachments from a toot draft." (interactive) (setq mastodon-toot--media-attachments nil) (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields)) (defun mastodon-toot--attach-media (file content-type description) - "" + "Prompt for a attachment FILE of CONTENT-TYPE with DESCRIPTION. +A preview is displayed in the toot create buffer, and the file +will be uploaded and attached to the toot upon sending." (interactive "fFilename: \nsContent type: \nsDescription: ") (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. @@ -462,9 +443,22 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (nconc mastodon-toot--media-attachments `(((:contents . ,(mastodon-http--read-file-as-string file)) (:content-type . ,content-type) - (:description . ,description))))) + (:description . ,description) + (:filename . ,(file-name-nondirectory file)))))) (mastodon-toot--refresh-attachments-display)) +(defun mastodon-toot--upload-media-attachments () + "Actually upload the attachment files using `mastodon-http--post-media-attachment'. +It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." + (interactive) + (mapcar (lambda (attachment) + (let* ((filename (cdr (assoc :filename attachment))) + (caption (cdr (assoc :description attachment))) + (url (concat mastodon-instance-url "/api/v1/media"))) + (message "Uploading %s..." filename) + (mastodon-http--post-media-attachment url filename caption))) + mastodon-toot--media-attachments)) + (defun mastodon-toot--refresh-attachments-display () (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range -- cgit v1.2.3 From 9564994df6ade898831789200d3ac133ba9de07e Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:19:20 +0200 Subject: flycheck toot.el --- lisp/mastodon-toot.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7407a7c..a040efc 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -50,6 +50,7 @@ (autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-toot "mastodon") (autoload 'mastodon-http--post-media-attachment "mastodon-http") +(autoload 'mastodon-http--read-file-as-string "mastodon-http") (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") @@ -331,9 +332,9 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) (args (append args-no-media args-media))) - (if (and mastodon-toot--media-attachments + (when (and mastodon-toot--media-attachments (equal mastodon-toot--media-attachment-ids nil)) - (message "Looks like your uploads are not yet ready...") + (message "Looks like your uploads are not yet ready...")) (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") (let ((response (mastodon-http--post endpoint args nil))) @@ -448,7 +449,7 @@ will be uploaded and attached to the toot upon sending." (mastodon-toot--refresh-attachments-display)) (defun mastodon-toot--upload-media-attachments () - "Actually upload the attachment files using `mastodon-http--post-media-attachment'. + "Actually upload attachments using `mastodon-http--post-media-attachment'. It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." (interactive) (mapcar (lambda (attachment) @@ -460,6 +461,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () + "Display attachment previews in toot draft buffer." (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range 'toot-attachments (point-min))) @@ -470,6 +472,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (list 'display (or (nth i display-specs) "")))))) (defun mastodon-toot--format-attachments () + "Format the attachment previews in toot draft buffer." (or (let ((counter 0) (image-options (when (or (image-type-available-p 'imagemagick) (image-transforms-p)) -- cgit v1.2.3 From 1f25073c25ae6c8e44c72028fbf873f24544b8e9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 15:27:51 +0200 Subject: remove my old attachment display --- lisp/mastodon-toot.el | 3 --- 1 file changed, 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a040efc..8dfe00b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -557,9 +557,6 @@ on the status of NSFW, content warning flags, media attachments, etc." (propertize "Visibility" 'toot-post-visibility t) " ⋅ " - (propertize "Attachment" - 'toot-attachment t) - " ⋅ " (propertize "CW" 'toot-post-cw-flag t) " " -- cgit v1.2.3 From 1ccf12b34c14c3cc5c58ccf214865b3af1719d54 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 17:13:47 +0200 Subject: binding to upload media, and check uploads up before posting toot --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 8dfe00b..86cecfd 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -118,6 +118,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) (when (require 'emojify nil :noerror) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) + (define-key map (kbd "C-c C-u") #'mastodon-toot--upload-attached-media) (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) map) @@ -332,16 +333,16 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) (args (append args-no-media args-media))) - (when (and mastodon-toot--media-attachments + (if (and mastodon-toot--media-attachments (equal mastodon-toot--media-attachment-ids nil)) - (message "Looks like your uploads are not yet ready...")) + (message "Looks like your uploads are not up: C-c C-u to upload...") (if empty-toot-p (message "Empty toot. Cowardly refusing to post this.") (let ((response (mastodon-http--post endpoint args nil))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!"))))))) + (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -448,7 +449,7 @@ will be uploaded and attached to the toot upon sending." (:filename . ,(file-name-nondirectory file)))))) (mastodon-toot--refresh-attachments-display)) -(defun mastodon-toot--upload-media-attachments () +(defun mastodon-toot--upload-attached-media () "Actually upload attachments using `mastodon-http--post-media-attachment'. It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." (interactive) -- cgit v1.2.3 From 765da49f980673863b09a814630646c8044c96ad Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 17:14:13 +0200 Subject: FIX the filename we send to post-media-attachement - it needs to be with full path of course! --- lisp/mastodon-toot.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 86cecfd..c00e4bf 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -446,7 +446,7 @@ will be uploaded and attached to the toot upon sending." `(((:contents . ,(mastodon-http--read-file-as-string file)) (:content-type . ,content-type) (:description . ,description) - (:filename . ,(file-name-nondirectory file)))))) + (:filename . ,file))))) (mastodon-toot--refresh-attachments-display)) (defun mastodon-toot--upload-attached-media () @@ -457,9 +457,9 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (let* ((filename (cdr (assoc :filename attachment))) (caption (cdr (assoc :description attachment))) (url (concat mastodon-instance-url "/api/v1/media"))) - (message "Uploading %s..." filename) + (message "Uploading %s..." (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () "Display attachment previews in toot draft buffer." -- cgit v1.2.3 From e0cabe76d4107610c44b1bc6c570840ebadb5467 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 15 Oct 2021 18:47:52 +0200 Subject: docstrings --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c00e4bf..ec5a8ac 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -462,7 +462,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () - "Display attachment previews in toot draft buffer." + "Update the display attachment previews in toot draft buffer." (let ((inhibit-read-only t) (attachments-region (mastodon-tl--find-property-range 'toot-attachments (point-min))) @@ -473,7 +473,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (list 'display (or (nth i display-specs) "")))))) (defun mastodon-toot--format-attachments () - "Format the attachment previews in toot draft buffer." + "Format the attachment previews for display in toot draft buffer." (or (let ((counter 0) (image-options (when (or (image-type-available-p 'imagemagick) (image-transforms-p)) -- cgit v1.2.3 From 1d94efdb2de1238cde0673d07e8268ff821ab815 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 20 Oct 2021 14:41:10 +0200 Subject: first go at company completion for mentions in new toots --- lisp/mastodon-search.el | 19 ++++++++++++++++++ lisp/mastodon-toot.el | 53 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 537a746..14e40d8 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -43,6 +43,25 @@ (defvar mastodon-tl--link-keymap) (defvar mastodon-http--timeout) +;; functions for company completion of mentions in mastodon-toot + +(defun mastodon-search--get-user-info-no-url (account) + "Get user handle, display name and account URL from ACCOUNT." + (list (cdr (assoc 'display_name account)) + (cdr (assoc 'acct account)))) + +(defun mastodon-search--search-accounts-query (query) + "Prompt for a search QUERY and return accounts. +Returns a nested list containing user handle, display name, and URL." + (interactive "sSearch mastodon for: ") + (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) + (buffer (format "*mastodon-search-%s*" query)) + (response (mastodon-http--get-search-json url query))) + (mapcar #'mastodon-search--get-user-info-no-url ;-handle-flat-propertized + response))) + +;; functions for mastodon search + (defun mastodon-search--search-query (query) "Prompt for a search QUERY and return accounts, statuses, and hashtags." (interactive "sSearch mastodon for: ") diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index a8b121b..f3cbfb0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -34,6 +34,9 @@ (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) +(require 'cl-lib) +(require 'company nil :noerror) + (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") @@ -51,6 +54,7 @@ (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") +(autoload 'mastodon-search--search-accounts-query "mastodon-search") (defgroup mastodon-toot nil "Tooting in Mastodon." @@ -73,6 +77,12 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :group 'mastodon-toot :type 'string) +(when (require 'company nil :noerror) + (defcustom mastodon-toot--use-company-completion-for-mentions t + "Whether to enable company completion for mentions in toot compose buffer." + :group 'mastodon-toot + :type 'boolean)) + (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) @@ -376,6 +386,46 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (reverse (append mentions nil)) ""))) +;; (defun mastodon-toot--mentions-company-meta (candidate) +;; (format "meta %s of candidate %s" +;; (get-text-property 0 'meta candidate) +;; (substring-no-properties candidate))) + +(defun mastodon-toot--mentions-company-annotation (candidate) + "Construct a company completion CANDIDATE's annotation for display." + (format " %s" (get-text-property 0 'meta candidate))) + +(defun mastodon-toot--mentions-company-candidates (prefix) + "Given a company PREFIX, build a list of candidates. +The prefix string is tested against both user handles and display names." + (let (res) + (dolist (item (mastodon-search--search-accounts-query prefix)) + (when (or (string-prefix-p prefix (cadr item)) + (string-prefix-p prefix (car item))) + (push (mastodon-toot--mentions-company-make-candidate item) res))) + res)) + +(defun mastodon-toot--mentions-company-make-candidate (candidate) + "Construct a company completion CANDIDATE for display." + (let ((display-name (car candidate)) + (handle (cadr candidate))) + (propertize handle 'meta display-name))) + +(defun mastodon-toot--mentions-company-backend (command &optional arg &rest ignored) + "A company completion backend for toot mentions." + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'mastodon-toot--mentions-company-backend)) + (prefix (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (backward-word) + (backward-char) + (looking-at "@")) ; if we have a mention + (company-grab-symbol))) ;; get thing before point, sans @ + (candidates (mastodon-toot--mentions-company-candidates arg)) + (annotation (mastodon-toot--mentions-company-annotation arg)))) + ;; (meta (mastodon-toot--mentions-company-meta arg)))) + (defun mastodon-toot--reply () "Reply to toot at `point'." (interactive) @@ -565,6 +615,9 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) + (when mastodon-toot--use-company-completion-for-mentions + (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend) + (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--update-status-fields))) -- cgit v1.2.3 From cd2497074c9d44f9fe302aaf3696a79acd93ece8 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 11:24:09 +0200 Subject: make add mentions-company-backend to company-backens buffer local - we add to company-backends rather than replacing it, but it is still only buffer local. --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 4215dec..6f2f8e4 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -678,7 +678,8 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) (when mastodon-toot--use-company-completion-for-mentions - (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend) + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend)) (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From a3361877511dbb573ef470caaec78cb9595cffbc Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 14:33:33 +0200 Subject: fix default-toot-visibility customize --- lisp/mastodon-toot.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6f2f8e4..da559ef 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -68,11 +68,11 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \"direct\"." :group 'mastodon-toot - :type 'choice - :options '("public" - "unlisted" - "private" - "direct")) + :type '(choice + (const :tag "public" "public") + (const :tag "unlisted" "unlisted") + (const :tag "followers only" "private") + (const :tag "direct" "direct"))) (defcustom mastodon-toot--default-media-directory "~/" "The default directory when prompting for a media file to upload." -- cgit v1.2.3 From c08bc9dea693388a779d5702fc6cc421353bb889 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 14:35:40 +0200 Subject: improvements to toot mentions completion - customize option for completion off, following-only, or all. - 'following=true' is forwarded to http--get-search accordingly. - use company-grab-symbol-cons + regex, prepend "@" to it - also prepend '@' to the list in get-user-info-no-url - this makes company display user handles prepended with '@', and to match and - enter a handle without duplicating the '@' --- lisp/mastodon-http.el | 14 ++++++++------ lisp/mastodon-search.el | 8 +++++--- lisp/mastodon-toot.el | 23 +++++++++++------------ 3 files changed, 24 insertions(+), 21 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 2d91840..fbcf855 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -163,18 +163,20 @@ Pass response buffer to CALLBACK function." (kill-buffer) (json-read-from-string json-string))) -(defun mastodon-http--get-search-json (url query) +(defun mastodon-http--get-search-json (url query &optional param) "Make GET request to URL, searching for QUERY and return JSON response." - (let ((buffer (mastodon-http--get-search url query))) + (let ((buffer (mastodon-http--get-search url query param))) (with-current-buffer buffer (mastodon-http--process-json-search)))) -(defun mastodon-http--get-search (base-url query) +(defun mastodon-http--get-search (base-url query &optional param) "Make GET request to BASE-URL, searching for QUERY. - -Pass response buffer to CALLBACK function." +Pass response buffer to CALLBACK function. +PARAM is a formatted request parameter, eg 'following=true'." (let ((url-request-method "GET") - (url (concat base-url "?q=" (url-hexify-string query))) + (url (if param + (concat base-url "?" param "&q=" (url-hexify-string query)) + (concat base-url "?q=" (url-hexify-string query)))) (url-request-extra-headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 14e40d8..40f134d 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -48,7 +48,7 @@ (defun mastodon-search--get-user-info-no-url (account) "Get user handle, display name and account URL from ACCOUNT." (list (cdr (assoc 'display_name account)) - (cdr (assoc 'acct account)))) + (concat "@" (cdr (assoc 'acct account))))) (defun mastodon-search--search-accounts-query (query) "Prompt for a search QUERY and return accounts. @@ -56,8 +56,10 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) (buffer (format "*mastodon-search-%s*" query)) - (response (mastodon-http--get-search-json url query))) - (mapcar #'mastodon-search--get-user-info-no-url ;-handle-flat-propertized + (response (if (equal mastodon-toot--enable-completion-for-mentions "followers") + (mastodon-http--get-search-json url query "following=true") + (mastodon-http--get-search-json url query)))) + (mapcar #'mastodon-search--get-user-info-no-url response))) ;; functions for mastodon search diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index da559ef..51c2431 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -80,10 +80,13 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :type 'string) (when (require 'company nil :noerror) - (defcustom mastodon-toot--use-company-completion-for-mentions t + (defcustom mastodon-toot--enable-completion-for-mentions "followers" "Whether to enable company completion for mentions in toot compose buffer." :group 'mastodon-toot - :type 'boolean)) + :type '(choice + (const :tag "off" nil) + (const :tag "followers only" "followers") + (const :tag "all users" "all")))) (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") @@ -406,20 +409,16 @@ The prefix string is tested against both user handles and display names." (handle (cadr candidate))) (propertize handle 'meta display-name))) -(defun mastodon-toot--mentions-company-backend (command &optional arg &rest ignored) +(defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) "A company completion backend for toot mentions." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot--mentions-company-backend)) + (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) (prefix (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - (save-excursion - (backward-word) - (backward-char) - (looking-at "@")) ; if we have a mention - (company-grab-symbol))) ;; get thing before point, sans @ + ;; @ + thing before point + (concat "@" (company-grab-symbol-cons "^@[0-9A-Za-z-.\\_@]+" 2)))) (candidates (mastodon-toot--mentions-company-candidates arg)) (annotation (mastodon-toot--mentions-company-annotation arg)))) - ;; (meta (mastodon-toot--mentions-company-meta arg)))) (defun mastodon-toot--reply () "Reply to toot at `point'." @@ -677,9 +676,9 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) (mastodon-toot-mode t) - (when mastodon-toot--use-company-completion-for-mentions + (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot--mentions-company-backend)) + (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) (company-mode-on)) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From 299356ebee27abb8b97cdd4546164b9918727844 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 15:28:27 +0200 Subject: replies to toots adopt their visibility status by default. this makes it so that if you reply to a direct message, your toot will also be direct by default. - we feed the reply's full toot JSON through the chain of functions called, all the way down to "setup-as-reply". that way, if anything else needs to be extracted when setting up a reply, it's all there. --- lisp/mastodon-toot.el | 18 +++++++++++------- lisp/mastodon.el | 5 ++--- 2 files changed, 13 insertions(+), 10 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 51c2431..fa44645 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -444,7 +444,7 @@ The prefix string is tested against both user handles and display names." mentions)) (concat (mastodon-toot--process-local user) mentions))) - id))) + id toot))) (defun mastodon-toot--toggle-warning () "Toggle `mastodon-toot--content-warning'." @@ -620,12 +620,16 @@ on the status of NSFW, content warning flags, media attachments, etc." 'read-only "Edit your message below." 'toot-post-header t)))) -(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id) +(defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "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))) + (let ((reply-visibility (cdr (assoc 'visibility reply-json)))) + (when reply-to-user + (insert (format "%s " reply-to-user)) + (setq mastodon-toot--reply-to-id reply-to-id) + (if (not (equal mastodon-toot--visibility + reply-visibility)) + (setq mastodon-toot--visibility reply-visibility))))) (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." @@ -663,7 +667,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face))))) -(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id) +(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id reply-json) "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." @@ -674,7 +678,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot-mode t) (when (not buffer-exists) (mastodon-toot--display-docs-and-status-fields) - (mastodon-toot--setup-as-reply reply-to-user reply-to-id)) + (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json)) (mastodon-toot-mode t) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index a06b18d..e6a01f8 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -206,13 +206,12 @@ Use. e.g. \"%c\" for your locale's date and time format." (message "Loading Mastodon account %s on %s..." (mastodon-auth--user-acct) mastodon-instance-url)))) ;;;###autoload -(defun mastodon-toot (&optional user reply-to-id) +(defun mastodon-toot (&optional user reply-to-id reply-json) "Update instance with new toot. Content is captured in a new buffer. - If USER is non-nil, insert after @ symbol to begin new toot. If REPLY-TO-ID is non-nil, attach new toot to a conversation." (interactive) - (mastodon-toot--compose-buffer user reply-to-id)) + (mastodon-toot--compose-buffer user reply-to-id reply-json)) ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () -- cgit v1.2.3 From 74570658d54f1b8afa7eb414516674c5e724ed70 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 15:41:05 +0200 Subject: when toot replied to has a CW, adopt it as default for replying toot --- lisp/mastodon-toot.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index fa44645..17ee473 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -92,6 +92,10 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) +(defvar mastodon-toot--content-warning-from-reply nil + "The content warning of the toot being replied to.") +(make-variable-buffer-local 'mastodon-toot--content-warning) + (defvar mastodon-toot--content-nsfw nil "A flag indicating whether the toot should be marked as NSFW.") (make-variable-buffer-local 'mastodon-toot--content-nsfw) @@ -332,7 +336,7 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (endpoint (mastodon-http--api "statuses")) (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) - (read-string "Warning: "))) + (read-string "Warning: " mastodon-toot--content-warning-from-reply))) (args-no-media `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -623,13 +627,17 @@ on the status of NSFW, content warning flags, media attachments, etc." (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "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 ((reply-visibility (cdr (assoc 'visibility reply-json)))) + (let ((reply-visibility (cdr (assoc 'visibility reply-json))) + (reply-cw (cdr (assoc 'spoiler_text reply-json)))) (when reply-to-user (insert (format "%s " reply-to-user)) (setq mastodon-toot--reply-to-id reply-to-id) (if (not (equal mastodon-toot--visibility reply-visibility)) - (setq mastodon-toot--visibility reply-visibility))))) + (setq mastodon-toot--visibility reply-visibility)) + (when reply-cw + (setq mastodon-toot--content-warning t) + (setq mastodon-toot--content-warning-from-reply reply-cw))))) (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." -- cgit v1.2.3 From 8d36399e239826b5a8cc34ce15306f9f51759a7f Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 16:17:43 +0200 Subject: redraft toots adopt visibility and CW of deleted toot --- lisp/mastodon-toot.el | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 17ee473..6e41fc1 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -92,7 +92,7 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" "A flag whether the toot should be marked with a content warning.") (make-variable-buffer-local 'mastodon-toot--content-warning) -(defvar mastodon-toot--content-warning-from-reply nil +(defvar mastodon-toot--content-warning-from-reply-or-redraft nil "The content warning of the toot being replied to.") (make-variable-buffer-local 'mastodon-toot--content-warning) @@ -277,7 +277,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s" id)))) + (url (mastodon-http--api (format "statuses/%s" id))) + (toot-cw (cdr (assoc 'spoiler_text toot))) + (toot-visibility (cdr (assoc 'visibility toot)))) (if (or (cdr (assoc 'reblog toot)) (not (equal (cdr (assoc 'acct (cdr (assoc 'account toot)))) @@ -294,7 +296,13 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." ;; (media (cdr (assoc 'media_attachments json-response)))) (mastodon-toot--compose-buffer nil nil) (goto-char (point-max)) - (insert content)))))))))) + (insert content) + ;; adopt visibility and CW from deleted toot: + (setq mastodon-toot--visibility toot-visibility) + (when toot-cw + (setq mastodon-toot--content-warning t) + (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) + (mastodon-toot--update-status-fields)))))))))) (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window." @@ -336,7 +344,7 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (endpoint (mastodon-http--api "statuses")) (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) - (read-string "Warning: " mastodon-toot--content-warning-from-reply))) + (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) (args-no-media `(("status" . ,toot) ("in_reply_to_id" . ,mastodon-toot--reply-to-id) ("visibility" . ,mastodon-toot--visibility) @@ -637,7 +645,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (setq mastodon-toot--visibility reply-visibility)) (when reply-cw (setq mastodon-toot--content-warning t) - (setq mastodon-toot--content-warning-from-reply reply-cw))))) + (setq mastodon-toot--content-warning-from-reply-or-redraft reply-cw))))) (defun mastodon-toot--update-status-fields (&rest args) "Update the status fields in the header based on the current state." @@ -675,7 +683,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (list 'invisible (not mastodon-toot--content-warning) 'face 'mastodon-cw-face))))) -(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id reply-json) +(defun mastodon-toot--compose-buffer (reply-to-user reply-to-id &optional reply-json) "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." -- cgit v1.2.3 From 2329c3a7fc7ab4beb8caaeaedfa2b17ea4cf1db2 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 16:40:31 +0200 Subject: revert to forward-whitespace -1 test for company - this is an attempt to only engage company completion when our "word" at point is prefixed with a "@" - for some reason i dont understand, using company-grab-symbol-cons "^@ ..." doesn't work here: typing words with no @ still triggers company --- lisp/mastodon-toot.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6e41fc1..3a8ae92 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -426,9 +426,13 @@ The prefix string is tested against both user handles and display names." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) - (prefix (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - ;; @ + thing before point - (concat "@" (company-grab-symbol-cons "^@[0-9A-Za-z-.\\_@]+" 2)))) + (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (forward-whitespace -1) + (forward-whitespace 1) + (looking-at "@"))) + ;; @ + thing before point + (concat "@" (company-grab-symbol)))) (candidates (mastodon-toot--mentions-company-candidates arg)) (annotation (mastodon-toot--mentions-company-annotation arg)))) -- cgit v1.2.3 From 53a9c944d06c01f1efc39e5c89eb362b2436dcc0 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 19:01:06 +0200 Subject: move attachments lower in toot-docs --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3a8ae92..9f9abea 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -611,10 +611,8 @@ on the status of NSFW, content warning flags, media attachments, etc." (concat divider "\n" (mastodon-toot--make-mode-docs) "\n" - divider "\n" - " Attachments: " - (propertize "None " 'toot-attachments t) - "\n" + ;; divider "\n" + ;; "\n" divider "\n" " " (propertize "Count" @@ -629,6 +627,9 @@ on the status of NSFW, content warning flags, media attachments, etc." (propertize "NSFW" 'toot-post-nsfw-flag t) "\n" + " Attachments: " + (propertize "None " 'toot-attachments t) + "\n" divider (propertize "\n" 'rear-nonsticky t)) -- cgit v1.2.3 From a3fd610b172ccad89a463709120ddf4aa27469b6 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 19:37:14 +0200 Subject: print toot keybinding docs in two columns --- lisp/mastodon-toot.el | 42 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 37 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9f9abea..5866636 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -586,19 +586,51 @@ e.g. mastodon-toot--send -> Send." "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))) + (format " %s - %s" key command))) (defun mastodon-toot--format-kbinds (kbinds) "Format a list of keybindings, KBINDS, for display in documentation." - (mapconcat 'identity (cons "" (mapcar #'mastodon-toot--format-kbind kbinds)) - "\n")) + (mapcar #'mastodon-toot--format-kbind kbinds)) + +(defvar mastodon-toot--kbinds-pairs nil + "Contains a list of paired toot compose buffer keybindings for inserting.") +(make-variable-buffer-local 'mastodon-toot--kbinds-pairs) + +(defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest) + "Return a list of strings each containing two formatted kbinds. +KBINDS-LIST is the list of formatted bindings to pair. +LONGEST is the length of the longest binding." + (when kbinds-list + (push (concat "\n" + (car kbinds-list) + (make-string (- (1+ longest) (length (car kbinds-list))) + ?\ ) + (cadr kbinds-list)) + mastodon-toot--kbinds-pairs) + (mastodon-toot--formatted-kbinds-pairs (cddr kbinds-list) longest)) + (reverse mastodon-toot--kbinds-pairs)) + +(defun mastodon-toot--formatted-kbinds-longest (kbinds-list) + "Return the length of the longest item in KBINDS-LIST." + (let ((lengths (mapcar (lambda (x) + (length x)) + kbinds-list))) + (car (sort lengths #'>)))) (defun mastodon-toot--make-mode-docs () "Create formatted documentation text for the mastodon-toot-mode." - (let ((kbinds (mastodon-toot--get-mode-kbinds))) + (let* ((kbinds (mastodon-toot--get-mode-kbinds)) + (longest-kbind + (mastodon-toot--formatted-kbinds-longest + (mastodon-toot--format-kbinds kbinds)))) (concat " Compose a new toot here. The following keybindings are available:" - (mastodon-toot--format-kbinds kbinds)))) + ;; (mastodon-toot--format-kbinds kbinds)))) + (mapconcat 'identity + (mastodon-toot--formatted-kbinds-pairs + (mastodon-toot--format-kbinds kbinds) + longest-kbind) + nil)))) (defun mastodon-toot--display-docs-and-status-fields () "Insert propertized text with documentation about `mastodon-toot-mode'. -- cgit v1.2.3 From 4e4c6358477aa74424638b1df6fdb13a77e6aaa0 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 20:41:44 +0200 Subject: fix cw test for replies and for redrafts: "" not nil. --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5866636..3a53851 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -299,7 +299,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (insert content) ;; adopt visibility and CW from deleted toot: (setq mastodon-toot--visibility toot-visibility) - (when toot-cw + (when (not (equal toot-cw "")) (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) (mastodon-toot--update-status-fields)))))))))) @@ -680,7 +680,7 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (if (not (equal mastodon-toot--visibility reply-visibility)) (setq mastodon-toot--visibility reply-visibility)) - (when reply-cw + (when (not (equal reply-cw "")) (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft reply-cw))))) -- cgit v1.2.3 From 846d588dc87b5135dc18b1d7cc873acadfd4c5a3 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 21 Oct 2021 20:42:28 +0200 Subject: redrafts adopt reply to id from deleted toot --- lisp/mastodon-toot.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3a53851..d6502f8 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -279,7 +279,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) (toot-cw (cdr (assoc 'spoiler_text toot))) - (toot-visibility (cdr (assoc 'visibility toot)))) + (toot-visibility (cdr (assoc 'visibility toot))) + (reply-id (cdr (assoc 'in_reply_to_id toot)))) (if (or (cdr (assoc 'reblog toot)) (not (equal (cdr (assoc 'acct (cdr (assoc 'account toot)))) @@ -297,7 +298,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (mastodon-toot--compose-buffer nil nil) (goto-char (point-max)) (insert content) - ;; adopt visibility and CW from deleted toot: + ;; adopt reply-to-id, visibility and CW from deleted toot: + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) (setq mastodon-toot--visibility toot-visibility) (when (not (equal toot-cw "")) (setq mastodon-toot--content-warning t) -- cgit v1.2.3 From b81c3259a5224e296e8cf8a62db19767490a2fcb Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 22 Oct 2021 00:11:48 +0200 Subject: collect max toot chars from server and display in new toot buffer --- lisp/mastodon-toot.el | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d6502f8..76c2f87 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -126,6 +126,9 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p "Buffer-local variable to hold the list of media attachments.") (make-variable-buffer-local 'mastodon-toot--media-attachments) +(defvar mastodon-toot--max-toot-chars nil + "The maximum allowed characters count for a single toot.") + (defvar mastodon-toot-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'mastodon-toot--send) @@ -141,6 +144,15 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p map) "Keymap for `mastodon-toot'.") +(defun mastodon-toot--get-max-toot-chars () + "" + (let ((instance-json (mastodon-http--get-json + (concat mastodon-instance-url + "/api/v1/instance")))) + (setq mastodon-toot--max-toot-chars + (number-to-string + (cdr (assoc 'max_toot_chars instance-json)))))) + (defun mastodon-toot--action-success (marker byline-region remove) "Insert/remove the text MARKER with 'success face in byline. @@ -703,8 +715,9 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (point-min)))) (add-text-properties (car count-region) (cdr count-region) (list 'display - (format "%s characters" - (- (point-max) (cdr header-region))))) + (format "%s/%s characters" + (- (point-max) (cdr header-region)) + mastodon-toot--max-toot-chars))) (add-text-properties (car visibility-region) (cdr visibility-region) (list 'display (format "Visibility: %s" @@ -736,6 +749,8 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (mastodon-toot--display-docs-and-status-fields) (mastodon-toot--setup-as-reply reply-to-user reply-to-id reply-json)) (mastodon-toot-mode t) + (unless mastodon-toot--max-toot-chars + (mastodon-toot--get-max-toot-chars)) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) -- cgit v1.2.3 From 315c5d31195253462e8862a7877d45911bfc9956 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 22 Oct 2021 12:00:21 +0200 Subject: use http--api in max-toot-chars fun --- lisp/mastodon-toot.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 76c2f87..824f0c6 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -145,10 +145,9 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p "Keymap for `mastodon-toot'.") (defun mastodon-toot--get-max-toot-chars () - "" + "Fetch max_toot_chars from `mastodon-instance-url'." (let ((instance-json (mastodon-http--get-json - (concat mastodon-instance-url - "/api/v1/instance")))) + (mastodon-http--api "instance")))) (setq mastodon-toot--max-toot-chars (number-to-string (cdr (assoc 'max_toot_chars instance-json)))))) -- cgit v1.2.3 From a0393146d3424d8e0f249d3947c54a9faf19e509 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 22 Oct 2021 12:00:54 +0200 Subject: bookmark/unbookmark toot funs --- lisp/mastodon-toot.el | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 824f0c6..80c63f6 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -318,6 +318,30 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) (mastodon-toot--update-status-fields)))))))))) +(defun mastodon-toot--bookmark-toot () + "Bookmark toot at point synchronously." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (url (mastodon-http--api (format "statuses/%s/bookmark" id)))) + (if (y-or-n-p (format "Bookmark this toot? ")) + (let ((response (mastodon-http--post url nil nil))) + (mastodon-http--triage response + (lambda () + (message "Toot bookmarked!"))))))) + +(defun mastodon-toot--unbookmark-toot () + "Bookmark toot at point synchronously." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) + (url (mastodon-http--api (format "statuses/%s/unbookmark" id)))) + (if (y-or-n-p (format "Remove this toot from your bookmarks? ")) + (let ((response (mastodon-http--post url nil nil))) + (mastodon-http--triage response + (lambda () + (message "Toot unbookmarked!"))))))) + (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window." (kill-buffer-and-window)) -- cgit v1.2.3 From 635bf869e3f87ad182d0288f0947ae4bf842ff4d Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 22 Oct 2021 13:00:04 +0200 Subject: flycheck, autoloads, docstrings --- lisp/mastodon-http.el | 5 +++-- lisp/mastodon-search.el | 3 ++- lisp/mastodon-toot.el | 8 ++++++-- lisp/mastodon.el | 3 ++- 4 files changed, 13 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index ea18da8..f092a2d 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -114,7 +114,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) (defun mastodon-http--read-file-as-string (filename) - "" + "Read a file FILENAME as a string. Used to generate image preview." (with-temp-buffer (insert-file-contents filename) (string-to-unibyte (buffer-string)))) @@ -170,7 +170,8 @@ Pass response buffer to CALLBACK function." (json-read-from-string json-string))) (defun mastodon-http--get-search-json (url query &optional param) - "Make GET request to URL, searching for QUERY and return JSON response." + "Make GET request to URL, searching for QUERY and return JSON response. +PARAM is any extra parameters to send with the request." (let ((buffer (mastodon-http--get-search url query param))) (with-current-buffer buffer (mastodon-http--process-json-search)))) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 40f134d..ccac5e6 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -42,6 +42,7 @@ (defvar mastodon-instance-url) (defvar mastodon-tl--link-keymap) (defvar mastodon-http--timeout) +(defvar mastodon-toot--enable-completion-for-mentions) ;; functions for company completion of mentions in mastodon-toot @@ -55,7 +56,7 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) - (buffer (format "*mastodon-search-%s*" query)) + ;; (buffer (format "*mastodon-search-%s*" query)) (response (if (equal mastodon-toot--enable-completion-for-mentions "followers") (mastodon-http--get-search-json url query "following=true") (mastodon-http--get-search-json url query)))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 80c63f6..d4068ea 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -31,6 +31,7 @@ (defvar mastodon-instance-url) (defvar mastodon-media--attachment-height) +(defvar mastodon-toot--enable-completion-for-mentions) (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) @@ -44,6 +45,7 @@ (autoload 'mastodon-http--triage "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") @@ -709,7 +711,8 @@ on the status of NSFW, content warning flags, media attachments, etc." (defun mastodon-toot--setup-as-reply (reply-to-user reply-to-id reply-json) "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." +If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'. +REPLY-JSON is the full JSON of the toot being replied to." (let ((reply-visibility (cdr (assoc 'visibility reply-json))) (reply-cw (cdr (assoc 'spoiler_text reply-json)))) (when reply-to-user @@ -762,7 +765,8 @@ If REPLY-TO-ID is provided, set the MASTODON-TOOT--REPLY-TO-ID var." (defun mastodon-toot--compose-buffer (reply-to-user reply-to-id &optional reply-json) "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." +If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var. +REPLY-JSON is the full JSON of the toot being replied to." (let* ((buffer-exists (get-buffer "*new toot*")) (buffer (or buffer-exists (get-buffer-create "*new toot*"))) (inhibit-read-only t)) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index e1bd2be..387e9eb 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -211,7 +211,8 @@ Use. e.g. \"%c\" for your locale's date and time format." (defun mastodon-toot (&optional user reply-to-id reply-json) "Update instance with new toot. Content is captured in a new buffer. If USER is non-nil, insert after @ symbol to begin new toot. -If REPLY-TO-ID is non-nil, attach new toot to a conversation." +If REPLY-TO-ID is non-nil, attach new toot to a conversation. +If REPLY-JSON is the json of the toot being replied to." (interactive) (mastodon-toot--compose-buffer user reply-to-id reply-json)) -- cgit v1.2.3 From 0a3bf6fcd92a52e8b3988f470fbf73a03a391739 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 22 Oct 2021 14:21:16 +0200 Subject: don't allow posts longer than server's max_toot_chars length --- lisp/mastodon-toot.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d4068ea..0153c9b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -401,13 +401,15 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (if (and mastodon-toot--media-attachments (equal mastodon-toot--media-attachment-ids nil)) (message "Looks like your uploads are not up: C-c C-u to upload...") - (if empty-toot-p - (message "Empty toot. Cowardly refusing to post this.") - (let ((response (mastodon-http--post endpoint args nil))) - (mastodon-http--triage response - (lambda () - (mastodon-toot--kill) - (message "Toot toot!")))))))) + (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) + (message "Looks like your toot is longer than that maximum allowed length.") + (if empty-toot-p + (message "Empty toot. Cowardly refusing to post this.") + (let ((response (mastodon-http--post endpoint args nil))) + (mastodon-http--triage response + (lambda () + (mastodon-toot--kill) + (message "Toot toot!"))))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". -- cgit v1.2.3 From a131a846daaf82061cff37f42ed16445dcdbe36a Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 22 Oct 2021 23:50:06 +0200 Subject: move defcustom attachment-height from media to toot - this makes the autoload fun mastodon-toot have access to the variable, so that it can be successfully called without mastodon-mode having been enabled previously. - maybe there is another work around for making variables available to autoloaded functions, but i failed to find it! --- lisp/mastodon-media.el | 5 ----- lisp/mastodon-toot.el | 11 +++++++---- 2 files changed, 7 insertions(+), 9 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index a401de5..1b6d054 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -51,11 +51,6 @@ :group 'mastodon-media :type 'integer) -(defcustom mastodon-media--attachment-height 80 - "Height of the attached images preview in the toot draft buffer." - :group 'mastodon-media - :type 'integer) - (defvar mastodon-media--generic-avatar-data (base64-decode-string "iVBORw0KGgoAAAANSUhEUgAAAGQAAABkCAIAAAD/gAIDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAA diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 0153c9b..cfc5182 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -29,9 +29,6 @@ ;;; Code: -(defvar mastodon-instance-url) -(defvar mastodon-media--attachment-height) -(defvar mastodon-toot--enable-completion-for-mentions) (when (require 'emojify nil :noerror) (declare-function emojify-insert-emoji "emojify")) @@ -39,6 +36,7 @@ (require 'cl-lib) (require 'company nil :noerror) +(defvar mastodon-instance-url) (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") @@ -81,6 +79,11 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :group 'mastodon-toot :type 'string) +(defcustom mastodon-toot--attachment-height 80 + "Height of the attached images preview in the toot draft buffer." + :group 'mastodon-media + :type 'integer) + (when (require 'company nil :noerror) (defcustom mastodon-toot--enable-completion-for-mentions "followers" "Whether to enable company completion for mentions in toot compose buffer." @@ -584,7 +587,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (or (let ((counter 0) (image-options (when (or (image-type-available-p 'imagemagick) (image-transforms-p)) - `(:height ,mastodon-media--attachment-height)))) + `(:height ,mastodon-toot--attachment-height)))) (mapcan (lambda (attachment) (let* ((data (cdr (assoc :contents attachment))) (image (apply #'create-image data -- cgit v1.2.3 From f892c5b28b829943619a0e810903c426308aa174 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 23 Oct 2021 11:31:52 +0200 Subject: rewrite bookmark-toot as toggle --- lisp/mastodon-toot.el | 37 +++++++++++++++++-------------------- lisp/mastodon.el | 3 ++- 2 files changed, 19 insertions(+), 21 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index cfc5182..983515e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -323,29 +323,26 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) (mastodon-toot--update-status-fields)))))))))) -(defun mastodon-toot--bookmark-toot () - "Bookmark toot at point synchronously." +(defun mastodon-toot--bookmark-toot-toggle () + "Bookmark or unbookmark toot at point synchronously." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s/bookmark" id)))) - (if (y-or-n-p (format "Bookmark this toot? ")) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "Toot bookmarked!"))))))) - -(defun mastodon-toot--unbookmark-toot () - "Bookmark toot at point synchronously." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s/unbookmark" id)))) - (if (y-or-n-p (format "Remove this toot from your bookmarks? ")) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "Toot unbookmarked!"))))))) + (bookmarked (cdr (assoc 'bookmarked toot))) + (url (mastodon-http--api (if (equal bookmarked t) + (format "statuses/%s/unbookmark" id) + (format "statuses/%s/bookmark" id)))) + (prompt (if (equal bookmarked t) + (format "Toot already bookmarked. Remove? ") + (format "Bookmark this toot? "))) + (message (if (equal bookmarked t) + "Bookmark removed!" + "Toot bookmarked!"))) + (when (y-or-n-p prompt) + (let ((response (mastodon-http--post url nil nil))) + (mastodon-http--triage response + (lambda () + (message message))))))) (defun mastodon-toot--kill () "Kill `mastodon-toot-mode' buffer and window." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 57f5721..7f4b773 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -82,6 +82,7 @@ (autoload 'mastodon-tl--poll-vote "mastodon-http") (autoload 'mastodon-toot--delete-and-redraft-toot "mastodon-toot") (autoload 'mastodon-profile--view-bookmarks "mastodon-profile") +(autoload 'mastodon-toot--bookmark-toot-toggle "mastodon-toot") (defgroup mastodon nil "Interface with Mastodon." @@ -158,7 +159,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept-notifs) (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject-notifs) (define-key map (kbd "v") #'mastodon-tl--poll-vote) - (define-key map (kbd "k") #'mastodon-toot--bookmark-toot) + (define-key map (kbd "k") #'mastodon-toot--bookmark-toot-toggle) (define-key map (kbd "K") #'mastodon-profile--view-bookmarks) map) -- cgit v1.2.3 From a79210d516d59d4603f243299cc0f313200d91f4 Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 25 Oct 2021 16:37:03 +0200 Subject: declare company-mode functions --- lisp/mastodon-toot.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 983515e..178df56 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -34,7 +34,11 @@ (declare-function emojify-insert-emoji "emojify")) (require 'cl-lib) -(require 'company nil :noerror) + +(when (require 'company nil :noerror) + (declare-function company-mode-on "company") + (declare-function company-begin-backend "company") + (declare-function company-grab-symbol "company")) (defvar mastodon-instance-url) (autoload 'mastodon-auth--user-acct "mastodon-auth") -- cgit v1.2.3 From 3a892a4caa8b77c7f634f192ea22620af6506877 Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 25 Oct 2021 16:37:29 +0200 Subject: _args for update-status-fields --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 178df56..44b0b3b 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -731,7 +731,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (setq mastodon-toot--content-warning t) (setq mastodon-toot--content-warning-from-reply-or-redraft reply-cw))))) -(defun mastodon-toot--update-status-fields (&rest args) +(defun mastodon-toot--update-status-fields (&rest _args) "Update the status fields in the header based on the current state." (ignore-errors ;; called from after-change-functions so let's not leak errors (let ((inhibit-read-only t) -- cgit v1.2.3 From f9a4bab4a81f96407c38a1a45719d45827b9f585 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 26 Oct 2021 17:51:53 +0200 Subject: toot--enable-completion-for-mentions only if company noerror - from testing with 'emacs -Q' --- lisp/mastodon-toot.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 44b0b3b..3e60d2d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -784,10 +784,11 @@ REPLY-JSON is the full JSON of the toot being replied to." (mastodon-toot-mode t) (unless mastodon-toot--max-toot-chars (mastodon-toot--get-max-toot-chars)) - (when mastodon-toot--enable-completion-for-mentions - (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) - (company-mode-on)) + (when (require 'company nil :noerror) + (when mastodon-toot--enable-completion-for-mentions + (set (make-local-variable 'company-backends) + (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) + (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) (mastodon-toot--refresh-attachments-display) -- cgit v1.2.3 From c60eb355232e57fec9fe97f366a3a2176f8c4110 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 26 Oct 2021 18:28:50 +0200 Subject: api/v2 for media attachment uploads --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 3e60d2d..14dcc29 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -567,7 +567,7 @@ It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used t (mapcar (lambda (attachment) (let* ((filename (cdr (assoc :filename attachment))) (caption (cdr (assoc :description attachment))) - (url (concat mastodon-instance-url "/api/v1/media"))) + (url (concat mastodon-instance-url "/api/v2/media"))) (message "Uploading %s..." (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) mastodon-toot--media-attachments)) -- cgit v1.2.3 From cde76175ea2e0ceeedeb993fdf818a01c379ece9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Thu, 28 Oct 2021 18:17:23 +0200 Subject: fix group of mastodon-toot--attachment-height --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 14dcc29..70b95d3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -85,7 +85,7 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" (defcustom mastodon-toot--attachment-height 80 "Height of the attached images preview in the toot draft buffer." - :group 'mastodon-media + :group 'mastodon-toot :type 'integer) (when (require 'company nil :noerror) -- cgit v1.2.3 From 4c7c6f4f3cb832cecc67da23e4567e11a236adf7 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 29 Oct 2021 11:18:57 +0200 Subject: fix for image uploads error in 'emacs -Q': expand file name! --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 70b95d3..309b64a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -565,7 +565,8 @@ will be uploaded and attached to the toot upon sending." It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." (interactive) (mapcar (lambda (attachment) - (let* ((filename (cdr (assoc :filename attachment))) + (let* ((filename (expand-file-name + (cdr (assoc :filename attachment)))) (caption (cdr (assoc :description attachment))) (url (concat mastodon-instance-url "/api/v2/media"))) (message "Uploading %s..." (file-name-nondirectory filename)) -- cgit v1.2.3 From 7e7b6c5c67af47c37d2a856dd72ccc040c967482 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 29 Oct 2021 17:55:27 +0200 Subject: merge upload-media-attachments functionality into toot-send. this obviates the need for the user to upload files before posting their toot. - this commit makes http--post-media-attachment synchronous, so that toot-send has to wait for it. - in toot-send: if mastodon-toot--media-attachements is non-nil, the files it contains are uploaded synchronously, and their returned ids are added to toot-media-attachment-ids, which are parsed as args for the POST request to be attached to the toot. - then we send toot as usual. - clear-all-attachments also clears mastodon-toot--media-attachment-ids just in case. - we have no more need of media-attachments-filenames, as media-attachments is now a list and not a boolean value. --- lisp/mastodon-http.el | 7 +++--- lisp/mastodon-toot.el | 70 +++++++++++++++++++++++---------------------------- 2 files changed, 36 insertions(+), 41 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index b5437a3..d6158eb 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -256,7 +256,9 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." ;; TODO: test for curl first? (defun mastodon-http--post-media-attachment (url filename caption) "Make POST request to upload FILENAME with CAPTION to the server's media URL. -The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' is set to the id(s) of the item uploaded, and `mastodon-toot--update-status-fields' is run." +The upload is asynchronous. On succeeding, +`mastodon-toot--media-attachment-ids' is set to the id(s) of the +item uploaded, and `mastodon-toot--update-status-fields' is run." (let* ((file (file-name-nondirectory filename)) (request-backend 'curl)) ;; (response @@ -269,14 +271,13 @@ The upload is asynchronous. On succeeding, `mastodon-toot--media-attachment-ids' :parser 'json-read :headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) - :sync nil + :sync t :success (cl-function (lambda (&key data &allow-other-keys) (when data (progn (push (cdr (assoc 'id data)) mastodon-toot--media-attachment-ids) ; add ID to list - (push file mastodon-toot--media-attachment-filenames) (message "%s file %s with id %S and caption '%s' uploaded!" (capitalize (cdr (assoc 'type data))) file diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 309b64a..063b346 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -116,25 +116,17 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (make-variable-buffer-local 'mastodon-toot--visibility) (defvar mastodon-toot--media-attachments nil - "A list of the media attachments of the toot being composed .") + "A list of the media attachments of the toot being composed.") (make-variable-buffer-local 'mastodon-toot--media-attachments) (defvar mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") (make-variable-buffer-local 'mastodon-toot--media-attachment-ids) -(defvar mastodon-toot--media-attachment-filenames nil - "A list of any media attachment filenames of the toot being composed.") -(make-variable-buffer-local 'mastodon-toot--media-attachment-filenames) - (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--media-attachments nil - "Buffer-local variable to hold the list of media attachments.") -(make-variable-buffer-local 'mastodon-toot--media-attachments) - (defvar mastodon-toot--max-toot-chars nil "The maximum allowed characters count for a single toot.") @@ -378,9 +370,11 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (message "Visibility set to %s" visibility)) (defun mastodon-toot--send () - "Kill new-toot buffer/window and POST contents to the Mastodon instance. - -If media items have been uploaded with `mastodon-toot--add-media-attachment', attach them to the toot." + "POST contents of the new-toot buffer/window to the Mastodon instance and kill the buffer. +If media items have been attached with +`mastodon-toot--attach-media', upload them with +`mastodon-toot-upload-attached-media' and attach them to the +toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) (empty-toot-p (and (not mastodon-toot--media-attachments) @@ -389,31 +383,28 @@ If media items have been uploaded with `mastodon-toot--add-media-attachment', at (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) - (args-no-media `(("status" . ,toot) - ("in_reply_to_id" . ,mastodon-toot--reply-to-id) - ("visibility" . ,mastodon-toot--visibility) - ("sensitive" . ,(when mastodon-toot--content-nsfw - (symbol-name t))) - ("spoiler_text" . ,spoiler))) - (args-media - (when mastodon-toot--media-attachment-ids - (mapcar - (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) - (args (append args-no-media args-media))) - (if (and mastodon-toot--media-attachments - (equal mastodon-toot--media-attachment-ids nil)) - (message "Looks like your uploads are not up: C-c C-u to upload...") - (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) - (message "Looks like your toot is longer than that maximum allowed length.") - (if empty-toot-p - (message "Empty toot. Cowardly refusing to post this.") - (let ((response (mastodon-http--post endpoint args nil))) - (mastodon-http--triage response - (lambda () - (mastodon-toot--kill) - (message "Toot toot!"))))))))) + (args `(("status" . ,toot) + ("in_reply_to_id" . ,mastodon-toot--reply-to-id) + ("visibility" . ,mastodon-toot--visibility) + ("sensitive" . ,(when mastodon-toot--content-nsfw + (symbol-name t))) + ("spoiler_text" . ,spoiler)))) + (when mastodon-toot--media-attachments + (mastodon-toot--upload-attached-media) ; sync upload so we wait (and pray) till done + (let* ((args-media (mapcar + (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids)) + (args (append args args-media))))) + (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) + (message "Looks like your toot is longer than that maximum allowed length.") + (if empty-toot-p + (message "Empty toot. Cowardly refusing to post this.") + (let ((response (mastodon-http--post endpoint args nil))) + (mastodon-http--triage response + (lambda () + (mastodon-toot--kill) + (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -541,6 +532,7 @@ The prefix string is tested against both user handles and display names." "Remove all attachments from a toot draft." (interactive) (setq mastodon-toot--media-attachments nil) + (setq mastodon-toot--media-attachment-ids nil) (mastodon-toot--refresh-attachments-display) (mastodon-toot--update-status-fields)) @@ -562,7 +554,9 @@ will be uploaded and attached to the toot upon sending." (defun mastodon-toot--upload-attached-media () "Actually upload attachments using `mastodon-http--post-media-attachment'. -It adds the items' ids to `mastodon-toot--media-attachment-ids', which is used to actually attach them to a toot after uploading." +The files to be uploaded are in `mastodon-toot--media-attachments'. +The items' ids are added to `mastodon-toot--media-attachment-ids', +which are used to attach them to a toot after uploading." (interactive) (mapcar (lambda (attachment) (let* ((filename (expand-file-name -- cgit v1.2.3 From d74f462624b66040a78a3e4a13ccb0d3c681f509 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 29 Oct 2021 18:12:31 +0200 Subject: docstrings --- lisp/mastodon-search.el | 2 +- lisp/mastodon-toot.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index ccac5e6..687b50c 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -52,7 +52,7 @@ (concat "@" (cdr (assoc 'acct account))))) (defun mastodon-search--search-accounts-query (query) - "Prompt for a search QUERY and return accounts. + "Prompt for a search QUERY and return accounts synchronously. Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 063b346..952ff58 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -444,7 +444,7 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--mentions-company-candidates (prefix) "Given a company PREFIX, build a list of candidates. -The prefix string is tested against both user handles and display names." +The prefix string can match against both user handles and display names." (let (res) (dolist (item (mastodon-search--search-accounts-query prefix)) (when (or (string-prefix-p prefix (cadr item)) -- cgit v1.2.3 From cf13db002b47f8e17267f48a0906be57d01eaf03 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 29 Oct 2021 19:00:22 +0200 Subject: make get-max-toot-chars async --- lisp/mastodon-toot.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 952ff58..57e279f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -146,12 +146,17 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p "Keymap for `mastodon-toot'.") (defun mastodon-toot--get-max-toot-chars () - "Fetch max_toot_chars from `mastodon-instance-url'." - (let ((instance-json (mastodon-http--get-json - (mastodon-http--api "instance")))) - (setq mastodon-toot--max-toot-chars - (number-to-string - (cdr (assoc 'max_toot_chars instance-json)))))) + "Fetch max_toot_chars from `mastodon-instance-url' asynchronously." + (mastodon-http--get-json-async + (mastodon-http--api "instance") 'mastodon-toot--get-max-toot-chars-callback)) + +(defun mastodon-toot--get-max-toot-chars-callback (json-response) + "Set max_toot_chars returned in JSON-RESPONSE." + (setq mastodon-toot--max-toot-chars + (number-to-string + (cdr (assoc 'max_toot_chars json-response)))) + (with-current-buffer "*new toot*" + (mastodon-toot--update-status-fields))) (defun mastodon-toot--action-success (marker byline-region remove) "Insert/remove the text MARKER with 'success face in byline. -- cgit v1.2.3 From 5d226e03737240a763419d1753769b983b46a1a9 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 29 Oct 2021 19:02:03 +0200 Subject: fix toot--send setting args/args-media --- lisp/mastodon-toot.el | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 57e279f..dd13251 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -139,7 +139,6 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (define-key map (kbd "C-c C-v") #'mastodon-toot--change-visibility) (when (require 'emojify nil :noerror) (define-key map (kbd "C-c C-e") #'mastodon-toot--insert-emoji)) - (define-key map (kbd "C-c C-u") #'mastodon-toot--upload-attached-media) (define-key map (kbd "C-c C-a") #'mastodon-toot--attach-media) (define-key map (kbd "C-c !") #'mastodon-toot--clear-all-attachments) map) @@ -375,7 +374,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (message "Visibility set to %s" visibility)) (defun mastodon-toot--send () - "POST contents of the new-toot buffer/window to the Mastodon instance and kill the buffer. + "POST contents of new-toot buffer to Mastodon instance and kill buffer. If media items have been attached with `mastodon-toot--attach-media', upload them with `mastodon-toot-upload-attached-media' and attach them to the @@ -388,19 +387,18 @@ toot." (spoiler (when (and (not empty-toot-p) mastodon-toot--content-warning) (read-string "Warning: " mastodon-toot--content-warning-from-reply-or-redraft))) - (args `(("status" . ,toot) - ("in_reply_to_id" . ,mastodon-toot--reply-to-id) - ("visibility" . ,mastodon-toot--visibility) - ("sensitive" . ,(when mastodon-toot--content-nsfw - (symbol-name t))) - ("spoiler_text" . ,spoiler)))) - (when mastodon-toot--media-attachments - (mastodon-toot--upload-attached-media) ; sync upload so we wait (and pray) till done - (let* ((args-media (mapcar - (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids)) - (args (append args args-media))))) + (args-no-media `(("status" . ,toot) + ("in_reply_to_id" . ,mastodon-toot--reply-to-id) + ("visibility" . ,mastodon-toot--visibility) + ("sensitive" . ,(when mastodon-toot--content-nsfw + (symbol-name t))) + ("spoiler_text" . ,spoiler))) + (args-media (when mastodon-toot--media-attachments + (mastodon-toot--upload-attached-media) ; sync upload so we wait (and pray) till done + (mapcar (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids))) + (args (append args-media args-no-media))) (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.") (if empty-toot-p @@ -562,7 +560,6 @@ will be uploaded and attached to the toot upon sending." The files to be uploaded are in `mastodon-toot--media-attachments'. The items' ids are added to `mastodon-toot--media-attachment-ids', which are used to attach them to a toot after uploading." - (interactive) (mapcar (lambda (attachment) (let* ((filename (expand-file-name (cdr (assoc :filename attachment)))) @@ -570,7 +567,7 @@ which are used to attach them to a toot after uploading." (url (concat mastodon-instance-url "/api/v2/media"))) (message "Uploading %s..." (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + mastodon-toot--media-attachments)) (defun mastodon-toot--refresh-attachments-display () "Update the display attachment previews in toot draft buffer." -- cgit v1.2.3 From 04465567450d6fc9cdec1a1ba0ef12557b0ab54b Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 1 Nov 2021 10:47:23 +0100 Subject: include user's profile URL in company mentions completion. also rename company mentions completion default value to "following" not "followers", which is what the actual search is called and what it returns. --- lisp/mastodon-search.el | 9 +++++---- lisp/mastodon-toot.el | 28 +++++++++++++++------------- 2 files changed, 20 insertions(+), 17 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 687b50c..03301ce 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -46,10 +46,11 @@ ;; functions for company completion of mentions in mastodon-toot -(defun mastodon-search--get-user-info-no-url (account) +(defun mastodon-search--get-user-info (account) "Get user handle, display name and account URL from ACCOUNT." (list (cdr (assoc 'display_name account)) - (concat "@" (cdr (assoc 'acct account))))) + (concat "@" (cdr (assoc 'acct account))) + (cdr (assoc 'url account)))) (defun mastodon-search--search-accounts-query (query) "Prompt for a search QUERY and return accounts synchronously. @@ -57,10 +58,10 @@ Returns a nested list containing user handle, display name, and URL." (interactive "sSearch mastodon for: ") (let* ((url (format "%s/api/v1/accounts/search" mastodon-instance-url)) ;; (buffer (format "*mastodon-search-%s*" query)) - (response (if (equal mastodon-toot--enable-completion-for-mentions "followers") + (response (if (equal mastodon-toot--enable-completion-for-mentions "following") (mastodon-http--get-search-json url query "following=true") (mastodon-http--get-search-json url query)))) - (mapcar #'mastodon-search--get-user-info-no-url + (mapcar #'mastodon-search--get-user-info response))) ;; functions for mastodon search diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index dd13251..b0b7e13 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -89,12 +89,12 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :type 'integer) (when (require 'company nil :noerror) - (defcustom mastodon-toot--enable-completion-for-mentions "followers" + (defcustom mastodon-toot--enable-completion-for-mentions "following" "Whether to enable company completion for mentions in toot compose buffer." :group 'mastodon-toot :type '(choice (const :tag "off" nil) - (const :tag "followers only" "followers") + (const :tag "following only" "following") (const :tag "all users" "all")))) (defvar mastodon-toot--content-warning nil @@ -436,18 +436,18 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (reverse (append mentions nil)) ""))) -;; (defun mastodon-toot--mentions-company-meta (candidate) -;; (format "meta %s of candidate %s" -;; (get-text-property 0 'meta candidate) -;; (substring-no-properties candidate))) +(defun mastodon-toot--mentions-company-meta (candidate) + "Format company completion CANDIDATE's meta field." + (format " %s" + (get-text-property 0 'meta candidate))) (defun mastodon-toot--mentions-company-annotation (candidate) - "Construct a company completion CANDIDATE's annotation for display." - (format " %s" (get-text-property 0 'meta candidate))) + "Format company completion CANDIDATE's annotation." + (format " %s" (get-text-property 0 'annot candidate))) (defun mastodon-toot--mentions-company-candidates (prefix) - "Given a company PREFIX, build a list of candidates. -The prefix string can match against both user handles and display names." + "Given a company PREFIX query, build a list of candidates. +The prefix can match against both user handles and display names." (let (res) (dolist (item (mastodon-search--search-accounts-query prefix)) (when (or (string-prefix-p prefix (cadr item)) @@ -458,8 +458,9 @@ The prefix string can match against both user handles and display names." (defun mastodon-toot--mentions-company-make-candidate (candidate) "Construct a company completion CANDIDATE for display." (let ((display-name (car candidate)) - (handle (cadr candidate))) - (propertize handle 'meta display-name))) + (handle (cadr candidate)) + (url (caddr candidate))) + (propertize handle 'annot display-name 'meta url))) (defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) "A company completion backend for toot mentions." @@ -474,7 +475,8 @@ The prefix string can match against both user handles and display names." ;; @ + thing before point (concat "@" (company-grab-symbol)))) (candidates (mastodon-toot--mentions-company-candidates arg)) - (annotation (mastodon-toot--mentions-company-annotation arg)))) + (annotation (mastodon-toot--mentions-company-annotation arg)) + (meta (mastodon-toot--mentions-company-meta arg)))) (defun mastodon-toot--reply () "Reply to toot at `point'." -- cgit v1.2.3 From d7593a06912b7946d2fb318093ec7e27c64b3be7 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Mon, 1 Nov 2021 12:28:32 +0100 Subject: Fix compilation warnings. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is mostly reflowing / reworkding docstrings to keep within 80 characters limit and adding autoloads. There are two warning remaining that I don't understand: - mastodon-async.el:359:16: Warning: reference to free variable ‘url-http-end-of-headers’ - mastodon-http.el:139:8: Warning: value returned from (string-equal json-string "") is unused When adding autoloads this sorts them for better readability. --- lisp/mastodon-async.el | 14 ++++++++++++-- lisp/mastodon-auth.el | 13 ++++++++++--- lisp/mastodon-http.el | 2 +- lisp/mastodon-media.el | 5 ++++- lisp/mastodon-notifications.el | 15 ++++++++------- lisp/mastodon-search.el | 9 ++------- lisp/mastodon-tl.el | 7 +++++-- lisp/mastodon-toot.el | 41 +++++++++++++++++++++++------------------ 8 files changed, 65 insertions(+), 41 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 6a421d1..56dc230 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -30,8 +30,14 @@ ;;; Code: (require 'json) +(require 'url-http) +(autoload 'mastodon-auth--access-token "mastodon-auth") +(autoload 'mastodon-http--api "mastodon-http") +(autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-mode "mastodon") (autoload 'mastodon-notifications--timeline "mastodon-notifications") +(autoload 'mastodon-tl--timeline "mastodon-tl") (defgroup mastodon-async nil "An async module for mastodon streams." @@ -129,7 +135,9 @@ Then start an async stream at ENDPOINT filtering toots using FILTER. TIMELINE is a specific target, such as federated or home. -NAME is the center portion of the buffer name for *mastodon-async-buffer and *mastodon-async-queue." +NAME is the center portion of the buffer name for +*mastodon-async-buffer and *mastodon-async-queue." + (ignore timeline) ;; TODO: figure out what this is meant to be used for (let ((buffer (mastodon-async--start-process endpoint filter name))) (with-current-buffer buffer @@ -238,7 +246,9 @@ Filter the toots using FILTER." (async-buffer (mastodon-async--setup-buffer "" (or name stream) endpoint)) (http-buffer (mastodon-async--get (mastodon-http--api stream) - (lambda (status) (message "HTTP SOURCE CLOSED"))))) + (lambda (status) + (ignore status) + (message "HTTP SOURCE CLOSED"))))) (mastodon-async--setup-http http-buffer (or name stream)) (mastodon-async--set-http-buffer async-buffer http-buffer) (mastodon-async--set-http-buffer async-queue http-buffer) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 0b0c703..b22b51e 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -63,7 +63,10 @@ if you are happy with unencryped storage use e.g. \"~/authinfo\"." (defun mastodon-auth--generate-token () "Make POST to generate auth token. -If no auth-sources file, runs `mastodon-auth--generate-token-no-storing-credentials'. If auth-sources file exists, runs `mastodon-auth--generate-token-and-store'." +If no auth-sources file, runs +`mastodon-auth--generate-token-no-storing-credentials'. If +auth-sources file exists, runs +`mastodon-auth--generate-token-and-store'." (if (or (null mastodon-auth-source-file) (string= "" mastodon-auth-source-file)) (mastodon-auth--generate-token-no-storing-credentials) @@ -124,9 +127,13 @@ Reads and/or stores secrets in `MASTODON-AUTH-SOURCE-FILE'." (json-read-from-string json-string)))) (defun mastodon-auth--access-token () - "If an access token for `mastodon-instance-url' is in `mastodon-auth--token-alist', return it. + "Return exiting or generate new access token. -Otherwise, generate a token and pass it to `mastodon-auth--handle-token-reponse'." +If an access token for `mastodon-instance-url' is in +`mastodon-auth--token-alist', return it. + +Otherwise, generate a token and pass it to +`mastodon-auth--handle-token-reponse'." (if-let ((token (cdr (assoc mastodon-instance-url mastodon-auth--token-alist)))) token diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d6158eb..27f8ef0 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -145,7 +145,7 @@ Pass response buffer to CALLBACK function." (buffer-substring-no-properties (point) (point-max)) 'utf-8))) (kill-buffer) - (unless (or (string= "" json-string) (equal nil json-string))) + (unless (or (string-equal "" json-string) (null json-string))) (json-read-from-string json-string))) (defun mastodon-http--delete (url) diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 808a23d..5f8f46c 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -32,6 +32,8 @@ ;; required by the server and client. ;;; Code: +(require 'url-cache) + (defvar url-show-status) (defvar mastodon-tl--shr-image-map-replacement) @@ -141,7 +143,8 @@ fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") 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." +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)))) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 2e9aea3..ad3d7b4 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -29,22 +29,23 @@ ;;; Code: +(autoload 'mastodon-http--api "mastodon-http.el") +(autoload 'mastodon-http--post "mastodon-http.el") +(autoload 'mastodon-http--triage "mastodon-http.el") (autoload 'mastodon-media--inline-images "mastodon-media.el") +(autoload 'mastodon-tl--byline "mastodon-tl.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--byline "mastodon-tl.el") -(autoload 'mastodon-tl--toot-id "mastodon-tl.el") (autoload 'mastodon-tl--field "mastodon-tl.el") +(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") (autoload 'mastodon-tl--has-spoiler "mastodon-tl.el") (autoload 'mastodon-tl--init "mastodon-tl.el") +(autoload 'mastodon-tl--init-sync "mastodon-tl.el") (autoload 'mastodon-tl--insert-status "mastodon-tl.el") -(autoload 'mastodon-tl--spoiler "mastodon-tl.el") (autoload 'mastodon-tl--property "mastodon-tl.el") -(autoload 'mastodon-tl--find-property-range "mastodon-tl.el") -(autoload 'mastodon-http--triage "mastodon-http.el") -(autoload 'mastodon-http--post "mastodon-http.el") -(autoload 'mastodon-http--api "mastodon-http.el") +(autoload 'mastodon-tl--spoiler "mastodon-tl.el") +(autoload 'mastodon-tl--toot-id "mastodon-tl.el") (defvar mastodon-tl--display-media-p) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 03301ce..2227d79 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -46,12 +46,6 @@ ;; functions for company completion of mentions in mastodon-toot -(defun mastodon-search--get-user-info (account) - "Get user handle, display name and account URL from ACCOUNT." - (list (cdr (assoc 'display_name account)) - (concat "@" (cdr (assoc 'acct account))) - (cdr (assoc 'url account)))) - (defun mastodon-search--search-accounts-query (query) "Prompt for a search QUERY and return accounts synchronously. Returns a nested list containing user handle, display name, and URL." @@ -161,7 +155,8 @@ We use this to fetch the complete status from the server." (defun mastodon-search--fetch-full-status-from-id (id) "Fetch the full status with id ID from the server. -This allows us to access the full account etc. details and to render them properly." +This allows us to access the full account etc. details and to +render them properly." (let* ((url (concat mastodon-instance-url "/api/v1/statuses/" (mastodon-tl--as-string id))) (json (mastodon-http--get-json url))) json)) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9bbc44f..e5ded3f 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -67,7 +67,7 @@ :group 'mastodon) (defcustom mastodon-tl--enable-relative-timestamps t - "Nonnil to enable showing relative (to the current time) timestamps. + "Whether to show relative (to the current time) timestamps. This will require periodic updates of a timeline buffer to keep the timestamps current as time progresses." @@ -630,7 +630,10 @@ Used for a mouse-click EVENT on a link." (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." + "Check if the given TOOT has a spoiler text. + +Spoiler text should initially be shown only while the main +content should be hidden." (let ((spoiler (mastodon-tl--field 'spoiler_text toot))) (and spoiler (> (length spoiler) 0)))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index b0b7e13..7698226 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -43,24 +43,25 @@ (defvar mastodon-instance-url) (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-http--delete "mastodon-http") -(autoload 'mastodon-http--process-json "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-json-async "mastodon-htpp") +(autoload 'mastodon-http--post "mastodon-http") +(autoload 'mastodon-http--post-media-attachment "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") +(autoload 'mastodon-http--read-file-as-string "mastodon-http") +(autoload 'mastodon-http--triage "mastodon-http") +(autoload 'mastodon-search--search-accounts-query "mastodon-search") (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-tl--clean-tabs-and-nl "mastodon-tl") (autoload 'mastodon-tl--field "mastodon-tl") (autoload 'mastodon-tl--find-property-range "mastodon-tl") +(autoload 'mastodon-tl--find-property-range "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") -(autoload 'mastodon-tl--find-property-range "mastodon-tl") -(autoload 'mastodon-toot "mastodon") -(autoload 'mastodon-http--post-media-attachment "mastodon-http") -(autoload 'mastodon-http--read-file-as-string "mastodon-http") -(autoload 'mastodon-tl--toot-id "mastodon-tl") (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") -(autoload 'mastodon-search--search-accounts-query "mastodon-search") +(autoload 'mastodon-tl--toot-id "mastodon-tl") +(autoload 'mastodon-toot "mastodon") (defgroup mastodon-toot nil "Tooting in Mastodon." @@ -70,7 +71,8 @@ (defcustom mastodon-toot--default-visibility "public" "The default visibility for new toots. -Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \"direct\"." +Must be one of \"public\", \"unlisted\", \"private\" (for +followers-only), or \"direct\"." :group 'mastodon-toot :type '(choice (const :tag "public" "public") @@ -88,14 +90,17 @@ Must be one of \"public\", \"unlisted\", \"private\" (for followers-only), or \" :group 'mastodon-toot :type 'integer) -(when (require 'company nil :noerror) - (defcustom mastodon-toot--enable-completion-for-mentions "following" - "Whether to enable company completion for mentions in toot compose buffer." - :group 'mastodon-toot - :type '(choice - (const :tag "off" nil) - (const :tag "following only" "following") - (const :tag "all users" "all")))) +(defcustom mastodon-toot--enable-completion-for-mentions (if (require 'company nil :noerror) "following" "off") + "Whether to enable company completion for mentions. + +Used for completion in toot compose buffer. + +This is only used if company mode is installed." + :group 'mastodon-toot + :type '(choice + (const :tag "off" nil) + (const :tag "following only" "following") + (const :tag "all users" "all"))) (defvar mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") -- cgit v1.2.3 From 681a39a2d1b8d88de37095ba5915ee55387dbc4f Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 5 Nov 2021 16:22:21 +0100 Subject: defvar company-backends for flycheck --- lisp/mastodon-toot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7698226..13d152a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -38,7 +38,8 @@ (when (require 'company nil :noerror) (declare-function company-mode-on "company") (declare-function company-begin-backend "company") - (declare-function company-grab-symbol "company")) + (declare-function company-grab-symbol "company") + (defvar company-backends)) (defvar mastodon-instance-url) (autoload 'mastodon-auth--user-acct "mastodon-auth") -- cgit v1.2.3 From 7e1fd71a793a8d5844eb332ccc1e54e80ecb5223 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 5 Nov 2021 16:22:39 +0100 Subject: support downloading/using custom emoji with emojify. - adds functions to download custom emoji from mastodon-instance-url, collect them into a list formatted as needed by emojify-user-emojis, and to update that var with the mastodon custom emoji so that they can be used with emojify-insert-emoji. - for now the user has to enable these by calling -enable-custom-emoji themselves. --- lisp/mastodon-toot.el | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 72 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 13d152a..d0d3dfa 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -31,7 +31,10 @@ (when (require 'emojify nil :noerror) - (declare-function emojify-insert-emoji "emojify")) + (declare-function emojify-insert-emoji "emojify") + (declare-function emojify-set-emoji-data "emojify") + (defvar emojify-emojis-dir) + (defvar emojify-user-emojis)) (require 'cl-lib) @@ -363,6 +366,74 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." 'emojify-insert-emoji "Prompt to insert an emoji.") +(defun mastodon-toot--download-custom-emoji () + "Download `mastodon-instance-url's custom emoji. +Emoji images are stored in a subdir of `emojify-emojis-dir'. +To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." + (interactive) + (let ((custom-emoji (mastodon-http--get-json + (mastodon-http--api "custom_emojis"))) + (mastodon-custom-emoji-dir (concat (expand-file-name + emojify-emojis-dir) + "/mastodon-custom-emojis/"))) + (if (not (file-exists-p emojify-emojis-dir)) + (message "Looks like you need to set up emojify first.") + (progn + (unless (file-directory-p mastodon-custom-emoji-dir) + (make-directory mastodon-custom-emoji-dir nil)) ; no add parent + (mapc (lambda (x) + (url-copy-file (alist-get 'url x) + (concat + mastodon-custom-emoji-dir + (alist-get 'shortcode x) + "." + (file-name-extension (alist-get 'url x))) + t)) + custom-emoji) + (message "Custom emoji for %s downloaded to %s" + mastodon-instance-url + mastodon-custom-emoji-dir))))) + +(defun mastodon-toot--collect-custom-emoji () + "Return a list of `mastodon-instance-url's custom emoji. +The list is formatted for `emojify-user-emojis', which see." + (let* ((mastodon-custom-emojis-dir (concat (expand-file-name + emojify-emojis-dir) + "/mastodon-custom-emojis/")) + (custom-emoji-files (directory-files mastodon-custom-emojis-dir + nil ; not full path + "^[^.]")) ; no dot files + (mastodon-emojify-user-emojis)) + (mapc (lambda (x) + (push + `(,(concat ":" + (file-name-base x) + ":") . (("name" . ,(file-name-base x)) + ("image" . ,(concat mastodon-custom-emojis-dir x)) + ("style" . "github"))) + mastodon-emojify-user-emojis)) + custom-emoji-files) + (reverse mastodon-emojify-user-emojis))) + +(defun mastodon-toot--enable-custom-emoji () + "Add `mastodon-instance-url's custom emoji to `emojify'. +Custom emoji must first be downloaded with +`mastodon-toot--download-custom-emoji'. Custom emoji are appended +to `emojify-user-emojis', and the emoji data is updated." + (interactive) + (unless (file-exists-p (concat (expand-file-name + emojify-emojis-dir) + "/mastodon-custom-emojis/")) + (when (y-or-n-p "Looks like you haven't downloaded your instance's custom emoji yet. Download now? ") + (mastodon-toot--download-custom-emoji))) + (setq emojify-user-emojis + (append (mastodon-toot--collect-custom-emoji) + emojify-user-emojis)) + ;; if already loaded, reload + (when (featurep 'emojify) + (emojify-set-emoji-data))) + + (defun mastodon-toot--remove-docs () "Get the body of a toot from the current compose buffer." (let ((header-region (mastodon-tl--find-property-range 'toot-post-header -- cgit v1.2.3 From 48f1193558c9655e2215615b5f6d0cf6ea4d4e08 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sat, 6 Nov 2021 15:50:40 +0100 Subject: tiny cleanup --- README.org | 1 + lisp/mastodon-notifications.el | 1 - lisp/mastodon-toot.el | 2 +- 3 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/README.org b/README.org index 2455124..3a7a06e 100644 --- a/README.org +++ b/README.org @@ -40,6 +40,7 @@ It adds the following features: | | media uploads previews in toot compose buffer | | =C-c C-n= | and sensitive media/nsfw flag | | =C-c C-e= | add emoji (if =emojify= installed) | +| | download and use your instance's custom emoji | | | replies preserve visibility status/CW of original toot | | | server's maximum toot length shown in toot compose buffer | | Search: | | diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ad3d7b4..36f9d4a 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -73,7 +73,6 @@ " " (cdr (assoc message mastodon-notifications--response-alist)))) - (defun mastodon-notifications--follow-request-accept-notifs () "Accept the follow request of user at point, in notifications view." (interactive) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d0d3dfa..deea2ef 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -159,7 +159,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p (mastodon-http--api "instance") 'mastodon-toot--get-max-toot-chars-callback)) (defun mastodon-toot--get-max-toot-chars-callback (json-response) - "Set max_toot_chars returned in JSON-RESPONSE." + "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer." (setq mastodon-toot--max-toot-chars (number-to-string (cdr (assoc 'max_toot_chars json-response)))) -- cgit v1.2.3 From b9d5d2ee57855653c32fe2fe2a495e5a3a038acf Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Tue, 2 Nov 2021 18:35:38 +0100 Subject: Use `defvar-local` to create buffer-local vars. This is much cleaner than first using `defvar` immediately followed by `make-variable-buffer-local`. --- lisp/mastodon-async.el | 15 ++++++--------- lisp/mastodon-profile.el | 3 +-- lisp/mastodon-tl.el | 12 ++++-------- lisp/mastodon-toot.el | 24 ++++++++---------------- 4 files changed, 19 insertions(+), 35 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 56dc230..f7bbdff 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -55,17 +55,14 @@ (defvar mastodon-tl--display-media-p) (defvar mastodon-tl--buffer-spec) -(make-variable-buffer-local - (defvar mastodon-async--queue "" ;;"*mastodon-async-queue*" - "The intermediate queue buffer name.")) +(defvar-local mastodon-async--queue "" ;;"*mastodon-async-queue*" + "The intermediate queue buffer name.") -(make-variable-buffer-local - (defvar mastodon-async--buffer "" ;;"*mastodon-async-buffer*" - "User facing output buffer name.")) +(defvar-local mastodon-async--buffer "" ;;"*mastodon-async-buffer*" + "User facing output buffer name.") -(make-variable-buffer-local - (defvar mastodon-async--http-buffer "" ;;"" - "Buffer variable bound to http output.")) +(defvar-local mastodon-async--http-buffer "" ;;"" + "Buffer variable bound to http output.") (defun mastodon-async--display-http () "Display the async HTTP input buffer." diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 018af21..31499ed 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -62,9 +62,8 @@ (defvar mastodon-tl--update-point) -(defvar mastodon-profile--account nil +(defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") -(make-variable-buffer-local 'mastodon-profile--account) ;; this way you can update it with C-M-x: (defvar mastodon-profile-mode-map diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b1b7c68..e4c179c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -82,9 +82,8 @@ By default fixed width fonts are used." :type '(boolean :tag "Enable using proportional rather than fixed \ width fonts when rendering HTML text")) -(defvar mastodon-tl--buffer-spec nil +(defvar-local mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") -(make-variable-buffer-local 'mastodon-tl--buffer-spec) (defcustom mastodon-tl--show-avatars nil "Whether to enable display of user avatars in timelines." @@ -97,22 +96,19 @@ width fonts when rendering HTML text")) ;; (image-transforms-p)) ;; "A boolean value stating whether to show avatars in timelines.") -(defvar mastodon-tl--update-point nil +(defvar-local mastodon-tl--update-point nil "When updating a mastodon buffer this is where new toots will be inserted. If nil `(point-min)' is used instead.") -(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 +(defvar-local 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 +(defvar-local 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))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index deea2ef..07b52e3 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -106,35 +106,28 @@ This is only used if company mode is installed." (const :tag "following only" "following") (const :tag "all users" "all"))) -(defvar mastodon-toot--content-warning nil +(defvar-local mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") -(make-variable-buffer-local 'mastodon-toot--content-warning) -(defvar mastodon-toot--content-warning-from-reply-or-redraft nil +(defvar-local mastodon-toot--content-warning-from-reply-or-redraft nil "The content warning of the toot being replied to.") -(make-variable-buffer-local 'mastodon-toot--content-warning) -(defvar mastodon-toot--content-nsfw nil +(defvar-local mastodon-toot--content-nsfw nil "A flag indicating whether the toot should be marked as NSFW.") -(make-variable-buffer-local 'mastodon-toot--content-nsfw) -(defvar mastodon-toot--visibility "public" +(defvar-local mastodon-toot--visibility "public" "A string indicating the visibility of the toot being composed. Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"public\".") -(make-variable-buffer-local 'mastodon-toot--visibility) -(defvar mastodon-toot--media-attachments nil +(defvar-local mastodon-toot--media-attachments nil "A list of the media attachments of the toot being composed.") -(make-variable-buffer-local 'mastodon-toot--media-attachments) -(defvar mastodon-toot--media-attachment-ids nil +(defvar-local mastodon-toot--media-attachment-ids nil "A list of any media attachment ids of the toot being composed.") -(make-variable-buffer-local 'mastodon-toot--media-attachment-ids) -(defvar mastodon-toot--reply-to-id nil +(defvar-local 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--max-toot-chars nil "The maximum allowed characters count for a single toot.") @@ -714,9 +707,8 @@ e.g. mastodon-toot--send -> Send." "Format a list of keybindings, KBINDS, for display in documentation." (mapcar #'mastodon-toot--format-kbind kbinds)) -(defvar mastodon-toot--kbinds-pairs nil +(defvar-local mastodon-toot--kbinds-pairs nil "Contains a list of paired toot compose buffer keybindings for inserting.") -(make-variable-buffer-local 'mastodon-toot--kbinds-pairs) (defun mastodon-toot--formatted-kbinds-pairs (kbinds-list longest) "Return a list of strings each containing two formatted kbinds. -- cgit v1.2.3 From 93950dbee4165c733fd8e0a4938fd7d0f462d908 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Tue, 2 Nov 2021 20:30:27 +0100 Subject: Reformat all code. Basically, in Emacs for each file: select all text and `indent-region`. - This also removes one redundant comment, and - fixes an error with json decoding where the `json-read-from-string` was actually not within the intended `unless` clause (which explains the warning about "result of (string-equal "" json-string) will be ignored" which I never understood. --- lisp/mastodon-async.el | 22 +- lisp/mastodon-http.el | 87 ++++---- lisp/mastodon-inspect.el | 2 +- lisp/mastodon-media.el | 4 +- lisp/mastodon-notifications.el | 68 +++--- lisp/mastodon-profile.el | 24 +-- lisp/mastodon-search.el | 78 +++---- lisp/mastodon-tl.el | 54 ++--- lisp/mastodon-toot.el | 106 ++++----- lisp/mastodon.el | 4 +- test/mastodon-auth-tests.el | 14 +- test/mastodon-client-tests.el | 64 +++--- test/mastodon-http-tests.el | 6 +- test/mastodon-media-tests.el | 266 +++++++++++------------ test/mastodon-notifications-test.el | 4 +- test/mastodon-tl-tests.el | 420 ++++++++++++++++++------------------ test/mastodon-toot-tests.el | 6 +- 17 files changed, 614 insertions(+), 615 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index f7bbdff..1fabee2 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -59,10 +59,10 @@ "The intermediate queue buffer name.") (defvar-local mastodon-async--buffer "" ;;"*mastodon-async-buffer*" - "User facing output buffer name.") + "User facing output buffer name.") (defvar-local mastodon-async--http-buffer "" ;;"" - "Buffer variable bound to http output.") + "Buffer variable bound to http output.") (defun mastodon-async--display-http () "Display the async HTTP input buffer." @@ -177,16 +177,16 @@ is not known when `mastodon-async--setup-buffer' is called." NAME is used to generate the display buffer and the queue." (let ((queue-name (concat " *mastodon-async-queue-" name "-" - mastodon-instance-url "*")) + mastodon-instance-url "*")) (buffer-name (concat "*mastodon-async-display-" name "-" - mastodon-instance-url "*"))) + mastodon-instance-url "*"))) (mastodon-async--set-local-variables http-buffer http-buffer buffer-name queue-name))) (defun mastodon-async--setup-queue (http-buffer name) "Sets up the buffer for the async queue." (let ((queue-name (concat " *mastodon-async-queue-" name "-" - mastodon-instance-url "*")) + mastodon-instance-url "*")) (buffer-name(concat "*mastodon-async-display-" name "-" mastodon-instance-url "*"))) (mastodon-async--set-local-variables queue-name http-buffer @@ -203,8 +203,8 @@ ENPOINT is the endpoint for the stream and timeline." mastodon-instance-url "*")) (buffer-name (concat "*mastodon-async-display-" name "-" mastodon-instance-url "*")) - ;; if user stream, we need "timelines/home" not "timelines/user" - ;; if notifs, we need "notifications" not "timelines/notifications" + ;; if user stream, we need "timelines/home" not "timelines/user" + ;; if notifs, we need "notifications" not "timelines/notifications" (endpoint (if (equal name "notifications") "notifications" (if (equal name "home") "timelines/home" (format "timelines/%s" endpoint))))) @@ -285,8 +285,8 @@ Filter the toots using FILTER." ;; NB notification events in streams include follow requests (let* ((split-strings (split-string string "\n" t)) (event-type (replace-regexp-in-string - "^event: " "" - (car split-strings))) + "^event: " "" + (car split-strings))) (data (replace-regexp-in-string "^data: " "" (cadr split-strings)))) (when (equal "notification" event-type) @@ -304,8 +304,8 @@ Filter the toots using FILTER." (defun mastodon-async--account-local-p (json) "Test JSON to see if account is local." (not (string-match-p - "@" - (cdr (assoc 'acct (cdr (assoc 'account json))))))) + "@" + (cdr (assoc 'acct (cdr (assoc 'account json))))))) (defun mastodon-async--output-toot (toot) "Process TOOT and prepend it to the async user-facing buffer." diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 875e9bf..a183ed7 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -153,8 +153,8 @@ is available we will call it with or without a timeout." (buffer-substring-no-properties (point) (point-max)) 'utf-8))) (kill-buffer) - (unless (or (string-equal "" json-string) (null json-string))) - (json-read-from-string json-string))) + (unless (or (string-equal "" json-string) (null json-string)) + (json-read-from-string json-string)))) (defun mastodon-http--delete (url) "Make DELETE request to URL." @@ -256,8 +256,8 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." args "&"))) (url-request-extra-headers - (append `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) - headers))) + (append `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) + headers))) (with-temp-buffer (url-retrieve url callback cbargs)))) @@ -269,46 +269,45 @@ The upload is asynchronous. On succeeding, item uploaded, and `mastodon-toot--update-status-fields' is run." (let* ((file (file-name-nondirectory filename)) (request-backend 'curl)) - ;; (response - (request - url - :type "POST" - :params `(("description" . ,caption)) - :files `(("file" . (,file :file ,filename - :mime-type "multipart/form-data"))) - :parser 'json-read - :headers `(("Authorization" . ,(concat "Bearer " - (mastodon-auth--access-token)))) - :sync t - :success (cl-function - (lambda (&key data &allow-other-keys) - (when data - (progn - (push (cdr (assoc 'id data)) - mastodon-toot--media-attachment-ids) ; add ID to list - (message "%s file %s with id %S and caption '%s' uploaded!" - (capitalize (cdr (assoc 'type data))) - file - (cdr (assoc 'id data)) - (cdr (assoc 'description data))) - (mastodon-toot--update-status-fields))))) - :error (cl-function - (lambda (&key error-thrown &allow-other-keys) - (cond - ;; handle curl errors first (eg 26, can't read file/path) - ;; because the '=' test below fails for them - ;; they have the form (error . error message 24) - ((not (proper-list-p error-thrown)) ; not dotted list - (message "Got error: %s. Shit went south." (cdr error-thrown))) - ;; handle mastodon api errors - ;; they have the form (error http 401) - ((= (car (last error-thrown)) 401) - (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) - ((= (car (last error-thrown)) 422) - (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown)) - (t - (message "Got error: %s Shit went south" - error-thrown)))))))) + (request + url + :type "POST" + :params `(("description" . ,caption)) + :files `(("file" . (,file :file ,filename + :mime-type "multipart/form-data"))) + :parser 'json-read + :headers `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))) + :sync t + :success (cl-function + (lambda (&key data &allow-other-keys) + (when data + (progn + (push (cdr (assoc 'id data)) + mastodon-toot--media-attachment-ids) ; add ID to list + (message "%s file %s with id %S and caption '%s' uploaded!" + (capitalize (cdr (assoc 'type data))) + file + (cdr (assoc 'id data)) + (cdr (assoc 'description data))) + (mastodon-toot--update-status-fields))))) + :error (cl-function + (lambda (&key error-thrown &allow-other-keys) + (cond + ;; handle curl errors first (eg 26, can't read file/path) + ;; because the '=' test below fails for them + ;; they have the form (error . error message 24) + ((not (proper-list-p error-thrown)) ; not dotted list + (message "Got error: %s. Shit went south." (cdr error-thrown))) + ;; handle mastodon api errors + ;; they have the form (error http 401) + ((= (car (last error-thrown)) 401) + (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) + ((= (car (last error-thrown)) 422) + (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown)) + (t + (message "Got error: %s Shit went south" + error-thrown)))))))) (provide 'mastodon-http) ;;; mastodon-http.el ends here diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index 2181ea2..4647335 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -59,7 +59,7 @@ (concat "*mastodon-inspect-toot-" (mastodon-tl--as-string (mastodon-tl--property 'toot-id)) "*") - (mastodon-tl--property 'toot-json))) + (mastodon-tl--property 'toot-json))) (defun mastodon-inspect--download-single-toot (toot-id) "Download the toot/status represented by TOOT-ID." diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 5f8f46c..f7386c6 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -161,7 +161,7 @@ with the image." t image-options)))) (when mastodon-media--enable-image-caching (unless (url-is-cached url) ; cache if not already cached - (url-store-in-cache url-buffer))) + (url-store-in-cache url-buffer))) (with-current-buffer (marker-buffer marker) ;; Save narrowing in our buffer (let ((inhibit-read-only t)) @@ -239,7 +239,7 @@ found." ;; 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]") + ;; Media links are 5 character ("[img]") ((eq media-type 'media-link) (list next-pos (+ next-pos 5) 'media-link))))))) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 36f9d4a..2430bcc 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -80,23 +80,23 @@ (let* ((toot-json (mastodon-tl--property 'toot-json)) (f-req-p (string= "follow_request" (cdr (assoc 'type toot-json))))) (if f-req-p - (let* ((account (cdr (assoc 'account toot-json))) - (id (cdr (assoc 'id account))) - (handle (cdr (assoc 'acct account))) - (name (cdr (assoc 'username account)))) - (if id - (let ((response - (mastodon-http--post - (concat - (mastodon-http--api "follow_requests") - (format "/%s/authorize" id)) - nil nil))) - (mastodon-http--triage response - (lambda () - (mastodon-notifications--get) - (message "Follow request of %s (@%s) accepted!" - name handle)))) - (message "No account result at point?"))) + (let* ((account (cdr (assoc 'account toot-json))) + (id (cdr (assoc 'id account))) + (handle (cdr (assoc 'acct account))) + (name (cdr (assoc 'username account)))) + (if id + (let ((response + (mastodon-http--post + (concat + (mastodon-http--api "follow_requests") + (format "/%s/authorize" id)) + nil nil))) + (mastodon-http--triage response + (lambda () + (mastodon-notifications--get) + (message "Follow request of %s (@%s) accepted!" + name handle)))) + (message "No account result at point?"))) (message "No follow request at point?"))))) (defun mastodon-notifications--follow-request-reject-notifs () @@ -106,23 +106,23 @@ (let* ((toot-json (mastodon-tl--property 'toot-json)) (f-req-p (string= "follow_request" (cdr (assoc 'type toot-json))))) (if f-req-p - (let* ((account (cdr (assoc 'account toot-json))) - (id (cdr (assoc 'id account))) - (handle (cdr (assoc 'acct account))) - (name (cdr (assoc 'username account)))) - (if id - (let ((response - (mastodon-http--post - (concat - (mastodon-http--api "follow_requests") - (format "/%s/reject" id)) - nil nil))) - (mastodon-http--triage response - (lambda () - (mastodon-notifications--get) - (message "Follow request of %s (@%s) rejected!" - name handle)))) - (message "No account result at point?"))) + (let* ((account (cdr (assoc 'account toot-json))) + (id (cdr (assoc 'id account))) + (handle (cdr (assoc 'acct account))) + (name (cdr (assoc 'username account)))) + (if id + (let ((response + (mastodon-http--post + (concat + (mastodon-http--api "follow_requests") + (format "/%s/reject" id)) + nil nil))) + (mastodon-http--triage response + (lambda () + (mastodon-notifications--get) + (message "Follow request of %s (@%s) rejected!" + name handle)))) + (message "No account result at point?"))) (message "No follow request at point?"))))) (defun mastodon-notifications--mention (note) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 31499ed..b68be6f 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -256,20 +256,20 @@ Returns a list of lists." (let* ((car-fields (mapcar 'car fields)) ;; (cdr-fields (mapcar 'cadr fields)) ;; (cdr-fields-rendered - ;; (list - ;; (mapcar (lambda (x) - ;; (mastodon-tl--render-text x nil)) - ;; cdr-fields))) + ;; (list + ;; (mapcar (lambda (x) + ;; (mastodon-tl--render-text x nil)) + ;; cdr-fields))) (left-width (car (sort (mapcar 'length car-fields) '>)))) - ;; (right-width (car (sort (mapcar 'length cdr-fields) '>)))) + ;; (right-width (car (sort (mapcar 'length cdr-fields) '>)))) (mapconcat (lambda (field) (mastodon-tl--render-text (concat (format "_ %s " (car field)) (make-string (- (+ 1 left-width) (length (car field))) ?_) (format " :: %s" (cadr field))) - ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_) - ;; " |") + ;; (make-string (- (+ 1 right-width) (length (cdr field))) ?_) + ;; " |") field)) ; nil)) ; hack to make links tabstops fields ""))) @@ -307,7 +307,7 @@ Returns a list of lists." account 'statuses_count))) (relationships (mastodon-profile--relationships-get id)) (followed-by-you (cdr (assoc 'following - (aref relationships 0)))) + (aref relationships 0)))) (follows-you (cdr (assoc 'followed_by (aref relationships 0)))) (followsp (or (equal follows-you 't) (equal followed-by-you 't))) @@ -327,9 +327,9 @@ Returns a list of lists." (is-followers (string= endpoint-type "followers")) (is-following (string= endpoint-type "following")) (endpoint-name (cond - (is-statuses " TOOTS ") - (is-followers " FOLLOWERS ") - (is-following " FOLLOWING ")))) + (is-statuses " TOOTS ") + (is-followers " FOLLOWERS ") + (is-following " FOLLOWING ")))) (insert "\n" (mastodon-profile--image-from-account account) @@ -382,7 +382,7 @@ Returns a list of lists." 'success)) (setq mastodon-tl--update-point (point)) (mastodon-media--inline-images (point-min) (point)) - ;; insert pinned toots first + ;; insert pinned toots first (when (and pinned (equal endpoint-type "statuses")) (mastodon-profile--insert-statuses-pinned pinned) (setq mastodon-tl--update-point (point))) ;updates to follow pinned toots diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 5f52bb7..cbb452d 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -80,7 +80,7 @@ Returns a nested list containing user handle, display name, and URL." (tags-list (mapcar #'mastodon-search--get-hashtag-info tags)) ;; (status-list (mapcar #'mastodon-search--get-status-info - ;; statuses)) + ;; statuses)) (status-ids-list (mapcar 'mastodon-search--get-id-from-status statuses)) (toots-list-json (mapcar #'mastodon-search--fetch-full-status-from-id @@ -97,42 +97,42 @@ Returns a nested list containing user handle, display name, and URL." " ------------\n\n") 'success)) (mapc (lambda (el) - (insert (propertize (car el) 'face 'mastodon-display-name-face) - " : \n : " - (propertize (concat "@" (car (cdr el))) - 'face 'mastodon-handle-face - 'mouse-face 'highlight - 'mastodon-tab-stop 'user-handle - 'keymap mastodon-tl--link-keymap - 'mastodon-handle (concat "@" (car (cdr el))) - 'help-echo (concat "Browse user profile of @" (car (cdr el)))) - " : \n" - "\n")) - user-ids) - ;; hashtag results: - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " HASHTAGS\n" - " ------------\n\n") - 'success)) - (mapc (lambda (el) - (insert " : #" - (propertize (car el) - 'mouse-face 'highlight - 'mastodon-tag (car el) - 'mastodon-tab-stop 'hashtag - 'help-echo (concat "Browse tag #" (car el)) - 'keymap mastodon-tl--link-keymap) - " : \n\n")) - tags-list) - ;; status results: - (insert (mastodon-tl--set-face - (concat "\n ------------\n" - " STATUSES\n" - " ------------\n") - 'success)) - (mapc 'mastodon-tl--toot toots-list-json) - (goto-char (point-min)))))) + (insert (propertize (car el) 'face 'mastodon-display-name-face) + " : \n : " + (propertize (concat "@" (car (cdr el))) + 'face 'mastodon-handle-face + 'mouse-face 'highlight + 'mastodon-tab-stop 'user-handle + 'keymap mastodon-tl--link-keymap + 'mastodon-handle (concat "@" (car (cdr el))) + 'help-echo (concat "Browse user profile of @" (car (cdr el)))) + " : \n" + "\n")) + user-ids) + ;; hashtag results: + (insert (mastodon-tl--set-face + (concat "\n ------------\n" + " HASHTAGS\n" + " ------------\n\n") + 'success)) + (mapc (lambda (el) + (insert " : #" + (propertize (car el) + 'mouse-face 'highlight + 'mastodon-tag (car el) + 'mastodon-tab-stop 'hashtag + 'help-echo (concat "Browse tag #" (car el)) + 'keymap mastodon-tl--link-keymap) + " : \n\n")) + tags-list) + ;; status results: + (insert (mastodon-tl--set-face + (concat "\n ------------\n" + " STATUSES\n" + " ------------\n") + 'success)) + (mapc 'mastodon-tl--toot toots-list-json) + (goto-char (point-min)))))) (defun mastodon-search--get-user-info (account) "Get user handle, display name and account URL from ACCOUNT." @@ -153,7 +153,7 @@ Returns a nested list containing user handle, display name, and URL." (cdr (assoc 'content status)))) (defun mastodon-search--get-id-from-status (status) - "Fetch the id from a STATUS returned by a search call to the server. + "Fetch the id from a STATUS returned by a search call to the server. We use this to fetch the complete status from the server." (cdr (assoc 'id status))) @@ -164,7 +164,7 @@ We use this to fetch the complete status from the server." This allows us to access the full account etc. details and to render them properly." (let* ((url (concat mastodon-instance-url "/api/v1/statuses/" (mastodon-tl--as-string id))) - (json (mastodon-http--get-json url))) + (json (mastodon-http--get-json url))) json)) (provide 'mastodon-search) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e4c179c..d300a09 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -91,10 +91,10 @@ width fonts when rendering HTML text")) :type '(boolean :tag "Whether to display user avatars in timelines")) ;; (defvar mastodon-tl--show-avatars nil - ;; (if (version< emacs-version "27.1") - ;; (image-type-available-p 'imagemagick) - ;; (image-transforms-p)) - ;; "A boolean value stating whether to show avatars in timelines.") +;; (if (version< emacs-version "27.1") +;; (image-type-available-p 'imagemagick) +;; (image-transforms-p)) +;; "A boolean value stating whether to show avatars in timelines.") (defvar-local mastodon-tl--update-point nil "When updating a mastodon buffer this is where new toots will be inserted. @@ -463,7 +463,7 @@ START and END are the boundaries of the link in the toot." (url-instance (concat "https://" (url-host (url-generic-parse-url url)))) (maybe-userhandle (if (string= mastodon-instance-url url-instance) - ; if handle is local, then no instance suffix: + ; if handle is local, then no instance suffix: (buffer-substring-no-properties start end) (mastodon-tl--extract-userhandle-from-url url (buffer-substring-no-properties start end))))) @@ -652,12 +652,12 @@ message is a link which unhides/hides the main body." (mastodon-tl--render-text spoiler toot)) 'default)) (message (concat ;"\n" - " ---------------\n" - " " (mastodon-tl--make-link - (concat "CW: " string) - 'content-warning) - "\n" - " ---------------\n")) + " ---------------\n" + " " (mastodon-tl--make-link + (concat "CW: " string) + 'content-warning) + "\n" + " ---------------\n")) (cw (mastodon-tl--set-face message 'mastodon-cw-face))) (concat cw @@ -747,10 +747,10 @@ takes a single function. By default it is (concat "Poll: \n\n" (mapconcat (lambda (option) (progn - (format "Option %s: %s, %s votes.\n" - (setq option-counter (1+ option-counter)) - (cdr (assoc 'title option)) - (cdr (assoc 'votes_count option))))) + (format "Option %s: %s, %s votes.\n" + (setq option-counter (1+ option-counter)) + (cdr (assoc 'title option)) + (cdr (assoc 'votes_count option))))) options "\n") "\n"))) @@ -764,8 +764,8 @@ takes a single function. By default it is (mastodon-tl--field 'poll toot))) (options (mastodon-tl--field 'options poll)) (options-titles (mapcar (lambda (x) - (cdr (assoc 'title x))) - options)) + (cdr (assoc 'title x))) + options)) (options-number-seq (number-sequence 1 (length options))) (options-numbers (mapcar (lambda(x) (number-to-string x)) @@ -775,16 +775,16 @@ takes a single function. By default it is ;; but also store both as cons cell as cdr, as we need it below (candidates (mapcar (lambda (cell) (cons (format "%s | %s" (car cell) (cdr cell)) - cell)) + cell)) options-alist))) (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) (message "No poll here.") ;; var "option" = just the cdr, a cons of option number and desc (cdr (assoc (completing-read "Poll option to vote for: " - candidates - nil ; (predicate) - t) ; require match + candidates + nil ; (predicate) + t) ; require match candidates)))))) (if (null (mastodon-tl--field 'poll (mastodon-tl--property 'toot-json))) (message "No poll here.") @@ -961,7 +961,7 @@ webapp" nil ; predicate 'confirm)))) (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) + user-handle (mastodon-profile--toot-json))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) (url (mastodon-http--api (format "accounts/%s/follow" user-id)))) @@ -983,7 +983,7 @@ webapp" nil ; predicate 'confirm)))) (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) + user-handle (mastodon-profile--toot-json))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) (url (mastodon-http--api (format "accounts/%s/unfollow" user-id)))) @@ -1006,7 +1006,7 @@ webapp" nil ; predicate 'confirm)))) (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) + user-handle (mastodon-profile--toot-json))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) (url (mastodon-http--api (format "accounts/%s/mute" user-id)))) @@ -1026,7 +1026,7 @@ webapp" (mutes-json (mastodon-http--get-json mutes-url)) (muted-accts (mapcar (lambda (muted) (cdr (assoc 'acct muted))) - mutes-json))) + mutes-json))) (completing-read "Handle of user to unmute: " muted-accts nil ; predicate @@ -1055,7 +1055,7 @@ webapp" nil ; predicate 'confirm)))) (let* ((account (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json))) + user-handle (mastodon-profile--toot-json))) (user-id (mastodon-profile--account-field account 'id)) (name (mastodon-profile--account-field account 'display_name)) (url (mastodon-http--api (format "accounts/%s/block" user-id)))) @@ -1074,7 +1074,7 @@ webapp" (let* ((blocks-url (mastodon-http--api (format "blocks"))) (blocks-json (mastodon-http--get-json blocks-url)) (blocked-accts (mapcar (lambda (blocked) - (cdr (assoc 'acct blocked))) + (cdr (assoc 'acct blocked))) blocks-json))) (completing-read "Handle of user to unblock: " blocked-accts diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 07b52e3..22eb626 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -184,9 +184,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." "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)))) + (mastodon-tl--as-string id) + "/" + action)))) (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response callback)))) @@ -312,7 +312,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (with-current-buffer response (let* ((json-response (mastodon-http--process-json)) (content (cdr (assoc 'text json-response)))) - ;; (media (cdr (assoc 'media_attachments json-response)))) + ;; (media (cdr (assoc 'media_attachments json-response)))) (mastodon-toot--compose-buffer nil nil) (goto-char (point-max)) (insert content) @@ -338,8 +338,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (format "Toot already bookmarked. Remove? ") (format "Bookmark this toot? "))) (message (if (equal bookmarked t) - "Bookmark removed!" - "Toot bookmarked!"))) + "Bookmark removed!" + "Toot bookmarked!"))) (when (y-or-n-p prompt) (let ((response (mastodon-http--post url nil nil))) (mastodon-http--triage response @@ -496,10 +496,10 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." "Extract mentions from STATUS and process them into a string." (interactive) (let* ((boosted (mastodon-tl--field 'reblog status)) - (mentions - (if boosted - (cdr (assoc 'mentions (cdr (assoc 'reblog status)))) - (cdr (assoc 'mentions status))))) + (mentions + (if boosted + (cdr (assoc 'mentions (cdr (assoc 'reblog status)))) + (cdr (assoc 'mentions status))))) (mapconcat (lambda(x) (mastodon-toot--process-local (cdr (assoc 'acct x)))) ;; reverse does not work on vectors in 24.5 @@ -534,19 +534,19 @@ The prefix can match against both user handles and display names." (defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) "A company completion backend for toot mentions." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) - (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode - (save-excursion - (forward-whitespace -1) - (forward-whitespace 1) - (looking-at "@"))) - ;; @ + thing before point - (concat "@" (company-grab-symbol)))) - (candidates (mastodon-toot--mentions-company-candidates arg)) - (annotation (mastodon-toot--mentions-company-annotation arg)) - (meta (mastodon-toot--mentions-company-meta arg)))) + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) + (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode + (save-excursion + (forward-whitespace -1) + (forward-whitespace 1) + (looking-at "@"))) + ;; @ + thing before point + (concat "@" (company-grab-symbol)))) + (candidates (mastodon-toot--mentions-company-candidates arg)) + (annotation (mastodon-toot--mentions-company-annotation arg)) + (meta (mastodon-toot--mentions-company-meta arg)))) (defun mastodon-toot--reply () "Reply to toot at `point'." @@ -803,38 +803,38 @@ REPLY-JSON is the full JSON of the toot being replied to." "Update the status fields in the header based on the current state." (ignore-errors ;; called from after-change-functions so let's not leak errors (let ((inhibit-read-only t) - (header-region (mastodon-tl--find-property-range 'toot-post-header + (header-region (mastodon-tl--find-property-range 'toot-post-header + (point-min))) + (count-region (mastodon-tl--find-property-range 'toot-post-counter (point-min))) - (count-region (mastodon-tl--find-property-range 'toot-post-counter + (visibility-region (mastodon-tl--find-property-range + 'toot-post-visibility (point-min))) + (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag (point-min))) - (visibility-region (mastodon-tl--find-property-range - 'toot-post-visibility (point-min))) - (nsfw-region (mastodon-tl--find-property-range 'toot-post-nsfw-flag - (point-min))) - (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag - (point-min)))) - (add-text-properties (car count-region) (cdr count-region) - (list 'display - (format "%s/%s characters" - (- (point-max) (cdr header-region)) - mastodon-toot--max-toot-chars))) - (add-text-properties (car visibility-region) (cdr visibility-region) - (list 'display - (format "Visibility: %s" - (if (equal - mastodon-toot--visibility - "private") - "followers-only" - mastodon-toot--visibility)))) - (add-text-properties (car nsfw-region) (cdr nsfw-region) - (list 'display (if mastodon-toot--content-nsfw - (if mastodon-toot--media-attachments - "NSFW" "NSFW (no effect until attachments added)") - "") - 'face 'mastodon-cw-face)) - (add-text-properties (car cw-region) (cdr cw-region) - (list 'invisible (not mastodon-toot--content-warning) - 'face 'mastodon-cw-face))))) + (cw-region (mastodon-tl--find-property-range 'toot-post-cw-flag + (point-min)))) + (add-text-properties (car count-region) (cdr count-region) + (list 'display + (format "%s/%s characters" + (- (point-max) (cdr header-region)) + mastodon-toot--max-toot-chars))) + (add-text-properties (car visibility-region) (cdr visibility-region) + (list 'display + (format "Visibility: %s" + (if (equal + mastodon-toot--visibility + "private") + "followers-only" + mastodon-toot--visibility)))) + (add-text-properties (car nsfw-region) (cdr nsfw-region) + (list 'display (if mastodon-toot--content-nsfw + (if mastodon-toot--media-attachments + "NSFW" "NSFW (no effect until attachments added)") + "") + 'face 'mastodon-cw-face)) + (add-text-properties (car cw-region) (cdr cw-region) + (list 'invisible (not mastodon-toot--content-warning) + 'face 'mastodon-cw-face))))) (defun mastodon-toot--compose-buffer (reply-to-user reply-to-id &optional reply-json) "Create a new buffer to capture text for a new toot. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index d405bed..826787a 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -204,8 +204,8 @@ Use. e.g. \"%c\" for your locale's date and time format." "favourites" "search")) (buffer (cl-some (lambda (el) - (get-buffer (concat "*mastodon-" el "*"))) - tls))) ; return first buff that exists + (get-buffer (concat "*mastodon-" el "*"))) + tls))) ; return first buff that exists (if buffer (switch-to-buffer buffer) (mastodon-tl--get-home-timeline) diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index 7daa4db..69c34a4 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -45,10 +45,10 @@ "Should generate token and return JSON response." (with-temp-buffer (with-mock - (mock (mastodon-auth--generate-token) => (progn - (insert "\n\n{\"access_token\":\"abcdefg\"}") - (current-buffer))) - (should (equal (mastodon-auth--get-token) '(:access_token "abcdefg")))))) + (mock (mastodon-auth--generate-token) => (progn + (insert "\n\n{\"access_token\":\"abcdefg\"}") + (current-buffer))) + (should (equal (mastodon-auth--get-token) '(:access_token "abcdefg")))))) (ert-deftest access-token-found () "Should return value in `mastodon-auth--token-alist' if found." @@ -61,6 +61,6 @@ (let ((mastodon-instance-url "https://instance.url") (mastodon-auth--token nil)) (with-mock - (mock (mastodon-auth--get-token) => '(:access_token "foobaz")) - (should (string= (mastodon-auth--access-token) "foobaz")) - (should (equal mastodon-auth--token-alist '(("https://instance.url" . "foobaz"))))))) + (mock (mastodon-auth--get-token) => '(:access_token "foobaz")) + (should (string= (mastodon-auth--access-token) "foobaz")) + (should (equal mastodon-auth--token-alist '(("https://instance.url" . "foobaz"))))))) diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el index dfe175b..d7f750d 100644 --- a/test/mastodon-client-tests.el +++ b/test/mastodon-client-tests.el @@ -17,30 +17,30 @@ "Should return client registration JSON." (with-temp-buffer (with-mock - (mock (mastodon-client--register) => (progn - (insert "\n\n{\"foo\":\"bar\"}") - (current-buffer))) - (should (equal (mastodon-client--fetch) '(:foo "bar")))))) + (mock (mastodon-client--register) => (progn + (insert "\n\n{\"foo\":\"bar\"}") + (current-buffer))) + (should (equal (mastodon-client--fetch) '(:foo "bar")))))) (ert-deftest store-1 () "Should return the client plist." (let ((mastodon-instance-url "http://mastodon.example") (plist '(:client_id "id" :client_secret "secret"))) (with-mock - (mock (mastodon-client--token-file) => "stubfile.plstore") - (mock (mastodon-client--fetch) => '(:client_id "id" :client_secret "secret")) - (let* ((plstore (plstore-open "stubfile.plstore")) - (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) - (should (equal (mastodon-client--store) plist)))))) + (mock (mastodon-client--token-file) => "stubfile.plstore") + (mock (mastodon-client--fetch) => '(:client_id "id" :client_secret "secret")) + (let* ((plstore (plstore-open "stubfile.plstore")) + (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) + (should (equal (mastodon-client--store) plist)))))) (ert-deftest store-2 () - "Should store client in `mastodon-client--token-file'." - (let* ((mastodon-instance-url "http://mastodon.example") - (plstore (plstore-open "stubfile.plstore")) - (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) - (plstore-close plstore) - (should (string= (plist-get client :client_id) "id")) - (should (string= (plist-get client :client_secret) "secret")))) + "Should store client in `mastodon-client--token-file'." + (let* ((mastodon-instance-url "http://mastodon.example") + (plstore (plstore-open "stubfile.plstore")) + (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) + (plstore-close plstore) + (should (string= (plist-get client :client_id) "id")) + (should (string= (plist-get client :client_secret) "secret")))) (ert-deftest read-finds-match () "Should return mastodon client from `mastodon-token-file' if it exists." @@ -60,8 +60,8 @@ (ert-deftest read-empty-store () "Should return nil if mastodon client is not present in the plstore." (with-mock - (mock (mastodon-client--token-file) => "fixture/empty.plstore") - (should (equal (mastodon-client--read) nil)))) + (mock (mastodon-client--token-file) => "fixture/empty.plstore") + (should (equal (mastodon-client--read) nil)))) (ert-deftest client-set-and-matching () "Should return `mastondon-client' if `mastodon-client--client-details-alist' is non-nil and instance url is included." @@ -75,29 +75,29 @@ (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist '(("http://other.example" :wrong)))) (with-mock - (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) - (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) - (should (equal mastodon-client--client-details-alist - '(("http://mastodon.example" :client_id "foo" :client_secret "bar") - ("http://other.example" :wrong))))))) + (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) + (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) + (should (equal mastodon-client--client-details-alist + '(("http://mastodon.example" :client_id "foo" :client_secret "bar") + ("http://other.example" :wrong))))))) (ert-deftest client-unset () "Should read from `mastodon-token-file' if available." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) (with-mock - (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) - (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) - (should (equal mastodon-client--client-details-alist - '(("http://mastodon.example" :client_id "foo" :client_secret "bar"))))))) + (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar")) + (should (equal (mastodon-client) '(:client_id "foo" :client_secret "bar"))) + (should (equal mastodon-client--client-details-alist + '(("http://mastodon.example" :client_id "foo" :client_secret "bar"))))))) (ert-deftest client-unset-and-not-in-storage () "Should store client data in plstore if it can't be read." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) (with-mock - (mock (mastodon-client--read)) - (mock (mastodon-client--store) => '(:client_id "foo" :client_secret "baz")) - (should (equal (mastodon-client) '(:client_id "foo" :client_secret "baz"))) - (should (equal mastodon-client--client-details-alist - '(("http://mastodon.example" :client_id "foo" :client_secret "baz"))))))) + (mock (mastodon-client--read)) + (mock (mastodon-client--store) => '(:client_id "foo" :client_secret "baz")) + (should (equal (mastodon-client) '(:client_id "foo" :client_secret "baz"))) + (should (equal mastodon-client--client-details-alist + '(("http://mastodon.example" :client_id "foo" :client_secret "baz"))))))) diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el index d0f715e..03d4f94 100644 --- a/test/mastodon-http-tests.el +++ b/test/mastodon-http-tests.el @@ -4,6 +4,6 @@ "Should make a `url-retrieve' of the given URL." (let ((callback-double (lambda () "double"))) (with-mock - (mock (mastodon-http--url-retrieve-synchronously "https://foo.bar/baz")) - (mock (mastodon-auth--access-token) => "test-token") - (mastodon-http--get "https://foo.bar/baz")))) + (mock (mastodon-http--url-retrieve-synchronously "https://foo.bar/baz")) + (mock (mastodon-auth--access-token) => "test-token") + (mastodon-http--get "https://foo.bar/baz")))) diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 20993f9..b537dfe 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -3,143 +3,143 @@ (ert-deftest mastodon-media:get-avatar-rendering () "Should return text with all expected properties." (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image * (when (version< emacs-version "27.1") 'imagemagick) t :height 123) => :mock-image) - - (let* ((mastodon-media--avatar-height 123) - (result (mastodon-media--get-avatar-rendering "http://example.org/img.png")) - (result-no-properties (substring-no-properties result)) - (properties (text-properties-at 0 result))) - (should (string= " " result-no-properties)) - (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) - (should (eq 'needs-loading (plist-get properties 'media-state))) - (should (eq 'avatar (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display)))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * (when (version< emacs-version "27.1") 'imagemagick) t :height 123) => :mock-image) + + (let* ((mastodon-media--avatar-height 123) + (result (mastodon-media--get-avatar-rendering "http://example.org/img.png")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= " " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'avatar (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display)))))) (ert-deftest mastodon-media:get-media-link-rendering () "Should return text with all expected properties." (with-mock - (mock (create-image * nil t) => :mock-image) - - (let* ((mastodon-media--preview-max-height 123) - (result (mastodon-media--get-media-link-rendering "http://example.org/img.png")) - (result-no-properties (substring-no-properties result)) - (properties (text-properties-at 0 result))) - (should (string= "[img] " result-no-properties)) - (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) - (should (eq 'needs-loading (plist-get properties 'media-state))) - (should (eq 'media-link (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display)))))) + (mock (create-image * nil t) => :mock-image) + + (let* ((mastodon-media--preview-max-height 123) + (result (mastodon-media--get-media-link-rendering "http://example.org/img.png")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= "[img] " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display)))))) (ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image - * - (when (version< emacs-version "27.1") 'imagemagick) - t :height 123) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - url - #'mastodon-media--process-image-response - `(:my-marker (:height 123) 1 ,url)) - => :called-as-expected) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering "http://example.org/img.png") - ":rest")) - - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image + * + (when (version< emacs-version "27.1") 'imagemagick) + t :height 123) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + url + #'mastodon-media--process-image-response + `(:my-marker (:height 123) 1 ,url)) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) (ert-deftest mastodon-media:load-image-from-url:avatar-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock - (mock (image-type-available-p 'imagemagick) => nil) - (mock (create-image * nil t) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - url - #'mastodon-media--process-image-response - `(:my-marker () 1 ,url)) - => :called-as-expected) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering "http://example.org/img.png") - ":rest")) - - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) + (mock (image-type-available-p 'imagemagick) => nil) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + url + #'mastodon-media--process-image-response + `(:my-marker () 1 ,url)) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) (ert-deftest mastodon-media:load-image-from-url:media-link-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image * nil t) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - "http://example.org/image.png" - #'mastodon-media--process-image-response - '(:my-marker (:max-height 321) 5 "http://example.org/image.png")) - => :called-as-expected) - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-media-link-rendering url) - ":rest")) - (let ((mastodon-media--preview-max-height 321)) - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + "http://example.org/image.png" + #'mastodon-media--process-image-response + '(:my-marker (:max-height 321) 5 "http://example.org/image.png")) + => :called-as-expected) + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-media-link-rendering url) + ":rest")) + (let ((mastodon-media--preview-max-height 321)) + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) (ert-deftest mastodon-media:load-image-from-url:media-link-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock - (mock (image-type-available-p 'imagemagick) => nil) - (mock (create-image * nil t) => '(image foo)) - (mock (copy-marker 7) => :my-marker ) - (mock (url-retrieve - "http://example.org/image.png" - #'mastodon-media--process-image-response - '(:my-marker () 5 "http://example.org/image.png")) - => :called-as-expected) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering url) - ":rest")) - (let ((mastodon-media--preview-max-height 321)) - (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) + (mock (image-type-available-p 'imagemagick) => nil) + (mock (create-image * nil t) => '(image foo)) + (mock (copy-marker 7) => :my-marker ) + (mock (url-retrieve + "http://example.org/image.png" + #'mastodon-media--process-image-response + '(:my-marker () 5 "http://example.org/image.png")) + => :called-as-expected) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering url) + ":rest")) + (let ((mastodon-media--preview-max-height 321)) + (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) (ert-deftest mastodon-media:load-image-from-url:url-fetching-fails () "Should cope with failures in url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) (with-mock - (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image - * - (when (version< emacs-version "27.1") 'imagemagick) - t :height 123) => '(image foo)) - (stub url-retrieve => (error "url-retrieve failed")) - - (with-temp-buffer - (insert (concat "Start:" - (mastodon-media--get-avatar-rendering "http://example.org/img.png") - ":rest")) - - (should (eq :loading-failed (mastodon-media--load-image-from-url url 'avatar 7 1))) - ;; the media state was updated so we won't load this again: - (should (eq 'loading-failed (get-text-property 7 'media-state))))))) + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image + * + (when (version< emacs-version "27.1") 'imagemagick) + t :height 123) => '(image foo)) + (stub url-retrieve => (error "url-retrieve failed")) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :loading-failed (mastodon-media--load-image-from-url url 'avatar 7 1))) + ;; the media state was updated so we won't load this again: + (should (eq 'loading-failed (get-text-property 7 'media-state))))))) (ert-deftest mastodon-media:process-image-response () "Should process the HTTP response and adjust the source buffer." (with-temp-buffer (with-mock - (let ((source-buffer (current-buffer)) + (let ((source-buffer (current-buffer)) used-marker saved-marker) (insert "start:") @@ -175,35 +175,35 @@ (ert-deftest mastodon-media:inline-images () "Should process all media in buffer." (with-mock - ;; Stub needed for the test setup: - (stub create-image => '(image ignored)) - - (let (marker-media-link marker-media-link-bad-url marker-false-media marker-avatar) - (with-temp-buffer - (insert "Some text before\n") - (setq marker-media-link (copy-marker (point))) - (insert (mastodon-media--get-media-link-rendering "http://example.org/i.jpg") - " some more text ") - (setq marker-media-link-bad-url (copy-marker (point))) - (insert (mastodon-media--get-media-link-rendering "/files/small/missing.png") - " some more text ") - (setq marker-false-media (copy-marker (point))) - (insert - ;; text that looks almost like an avatar but lacks the media-url property - (propertize "this won't be processed" - 'media-state 'needs-loading - 'media-type 'avatar) - "even more text ") - (setq marker-avatar (copy-marker (point))) - (insert (mastodon-media--get-avatar-rendering "http://example.org/avatar.png") - " end of text") - (goto-char (point-min)) - - ;; stub for the actual test: - (stub mastodon-media--load-image-from-url) - (mastodon-media--inline-images (point-min) (point-max)) - - (should (eq 'loading (get-text-property marker-media-link 'media-state))) - (should (eq 'invalid-url (get-text-property marker-media-link-bad-url 'media-state))) - (should (eq 'loading (get-text-property marker-avatar 'media-state))) - (should (eq 'needs-loading (get-text-property marker-false-media 'media-state))))))) + ;; Stub needed for the test setup: + (stub create-image => '(image ignored)) + + (let (marker-media-link marker-media-link-bad-url marker-false-media marker-avatar) + (with-temp-buffer + (insert "Some text before\n") + (setq marker-media-link (copy-marker (point))) + (insert (mastodon-media--get-media-link-rendering "http://example.org/i.jpg") + " some more text ") + (setq marker-media-link-bad-url (copy-marker (point))) + (insert (mastodon-media--get-media-link-rendering "/files/small/missing.png") + " some more text ") + (setq marker-false-media (copy-marker (point))) + (insert + ;; text that looks almost like an avatar but lacks the media-url property + (propertize "this won't be processed" + 'media-state 'needs-loading + 'media-type 'avatar) + "even more text ") + (setq marker-avatar (copy-marker (point))) + (insert (mastodon-media--get-avatar-rendering "http://example.org/avatar.png") + " end of text") + (goto-char (point-min)) + + ;; stub for the actual test: + (stub mastodon-media--load-image-from-url) + (mastodon-media--inline-images (point-min) (point-max)) + + (should (eq 'loading (get-text-property marker-media-link 'media-state))) + (should (eq 'invalid-url (get-text-property marker-media-link-bad-url 'media-state))) + (should (eq 'loading (get-text-property marker-avatar 'media-state))) + (should (eq 'needs-loading (get-text-property marker-false-media 'media-state))))))) diff --git a/test/mastodon-notifications-test.el b/test/mastodon-notifications-test.el index 778d350..3047ae6 100644 --- a/test/mastodon-notifications-test.el +++ b/test/mastodon-notifications-test.el @@ -185,8 +185,8 @@ "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" )) - (mastodon-notifications--get)))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" )) + (mastodon-notifications--get)))) (defun mastodon-notifications--test-type (fun sample) "Test notification draw functions. diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 24de5d0..4edf5d5 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -114,19 +114,19 @@ (ert-deftest as-string-1 () "Should accept a string or number and return a string." (let ((id "1000")) - (should (string= (mastodon-tl--as-string id) id)))) + (should (string= (mastodon-tl--as-string id) id)))) (ert-deftest as-string-2 () "Should accept a string or number and return a string." (let ((id 1000)) - (should (string= (mastodon-tl--as-string id) (number-to-string id))))) + (should (string= (mastodon-tl--as-string id) (number-to-string id))))) (ert-deftest more-json () "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) - (mastodon-tl--more-json "timelines/foo" 12345)))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) + (mastodon-tl--more-json "timelines/foo" 12345)))) (ert-deftest more-json-id-string () "Should request toots older than max_id. @@ -135,8 +135,8 @@ a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) - (mastodon-tl--more-json "timelines/foo" "12345")))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) + (mastodon-tl--more-json "timelines/foo" "12345")))) (ert-deftest update-json-id-string () "Should request toots more recent than since_id. @@ -145,8 +145,8 @@ a string or a numeric." a string or a numeric." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345")) - (mastodon-tl--updated-json "timelines/foo" "12345")))) + (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?since_id=12345")) + (mastodon-tl--updated-json "timelines/foo" "12345")))) (ert-deftest mastodon-tl--relative-time-description () "Should format relative time as expected" @@ -156,10 +156,10 @@ a string or a numeric." (weeks (n) (* n (days 7))) (years (n) (* n (days 365))) (format-seconds-since (seconds) - (let ((timestamp (time-subtract (current-time) (seconds-to-time seconds)))) - (mastodon-tl--relative-time-description timestamp))) + (let ((timestamp (time-subtract (current-time) (seconds-to-time seconds)))) + (mastodon-tl--relative-time-description timestamp))) (check (seconds expected) - (should (string= (format-seconds-since seconds) expected)))) + (should (string= (format-seconds-since seconds) expected)))) (check 1 "less than a minute ago") (check 59 "less than a minute ago") (check 60 "one minute ago") @@ -195,33 +195,33 @@ a string or a numeric." (weeks (n) (* n (days 7))) (years (n) (* n (days 365.25))) (next-update (seconds-ago) - (let* ((timestamp (time-subtract current-time - (seconds-to-time seconds-ago)))) - (cdr (mastodon-tl--relative-time-details timestamp current-time)))) + (let* ((timestamp (time-subtract current-time + (seconds-to-time seconds-ago)))) + (cdr (mastodon-tl--relative-time-details timestamp current-time)))) (check (seconds-ago) - (let* ((timestamp (time-subtract current-time (seconds-to-time seconds-ago))) - (at-now (mastodon-tl--relative-time-description timestamp current-time)) - (at-one-second-before (mastodon-tl--relative-time-description - timestamp - (time-subtract (next-update seconds-ago) - (seconds-to-time 1)))) - (at-result (mastodon-tl--relative-time-description - timestamp - (next-update seconds-ago)))) - (when nil ;; change to t to debug test failures - (prin1 (format "\nFor %s: %s / %s" - seconds-ago - (time-to-seconds - (time-subtract (next-update seconds-ago) - timestamp)) - (round - (time-to-seconds - (time-subtract (next-update seconds-ago) - current-time)))))) - ;; a second earlier the description is the same as at current time - (should (string= at-now at-one-second-before)) - ;; but at the result time it is different - (should-not (string= at-one-second-before at-result))))) + (let* ((timestamp (time-subtract current-time (seconds-to-time seconds-ago))) + (at-now (mastodon-tl--relative-time-description timestamp current-time)) + (at-one-second-before (mastodon-tl--relative-time-description + timestamp + (time-subtract (next-update seconds-ago) + (seconds-to-time 1)))) + (at-result (mastodon-tl--relative-time-description + timestamp + (next-update seconds-ago)))) + (when nil ;; change to t to debug test failures + (prin1 (format "\nFor %s: %s / %s" + seconds-ago + (time-to-seconds + (time-subtract (next-update seconds-ago) + timestamp)) + (round + (time-to-seconds + (time-subtract (next-update seconds-ago) + current-time)))))) + ;; a second earlier the description is the same as at current time + (should (string= at-now at-one-second-before)) + ;; but at the result time it is different + (should-not (string= at-one-second-before at-result))))) (check 0) (check 1) (check 59) @@ -253,39 +253,39 @@ a string or a numeric." (let ((mastodon-tl--show-avatars-p nil) (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (handle-location 20)) - (should (string= (substring-no-properties - byline) - "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (handle-location 20)) + (should (string= (substring-no-properties + byline) + "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ ")) - (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) - 'user-handle)) - (should (string= (get-text-property handle-location 'mastodon-handle byline) - "@acct42@example.space")) - (should (equal (get-text-property handle-location 'help-echo byline) - "Browse user profile of @acct42@example.space")))))) + (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (string= (get-text-property handle-location 'mastodon-handle byline) + "@acct42@example.space")) + (should (equal (get-text-property handle-location 'help-echo byline) + "Browse user profile of @acct42@example.space")))))) (ert-deftest mastodon-tl--byline-regular-with-avatar () "Should format the regular toot correctly." (let ((mastodon-tl--show-avatars-p t) (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock - (stub create-image => '(image "fake data")) - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline mastodon-tl-test-base-toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (stub create-image => '(image "fake data")) + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline mastodon-tl-test-base-toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -295,14 +295,14 @@ a string or a numeric." (toot (cons '(reblogged . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -312,14 +312,14 @@ a string or a numeric." (toot (cons '(favourited . t) mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -330,14 +330,14 @@ a string or a numeric." (toot `((favourited . t) (reblogged . t) ,@mastodon-tl-test-base-toot)) (timestamp (cdr (assoc 'created_at toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 ------------ "))))) @@ -349,31 +349,31 @@ a string or a numeric." (timestamp (cdr (assoc 'created_at toot))) (original-timestamp (cdr (assoc 'created_at original-toot)))) (with-mock - ;; We don't expect to use the toot's timestamp but the timestamp of the - ;; reblogged toot: - (mock (date-to-time timestamp) => '(1 2)) - (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") - (mock (date-to-time original-timestamp) => '(3 4)) - (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") - - (let ((byline (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (handle1-location 20) - (handle2-location 65)) - (should (string= (substring-no-properties byline) - "Account 42 (@acct42@example.space) + ;; We don't expect to use the toot's timestamp but the timestamp of the + ;; reblogged toot: + (mock (date-to-time timestamp) => '(1 2)) + (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") + (mock (date-to-time original-timestamp) => '(3 4)) + (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + + (let ((byline (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (handle1-location 20) + (handle2-location 65)) + (should (string= (substring-no-properties byline) + "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ ")) - (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) - 'user-handle)) - (should (equal (get-text-property handle1-location 'help-echo byline) - "Browse user profile of @acct42@example.space")) - (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) - 'user-handle)) - (should (equal (get-text-property handle2-location 'help-echo byline) - "Browse user profile of @acct43@example.space")))))) + (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (equal (get-text-property handle1-location 'help-echo byline) + "Browse user profile of @acct42@example.space")) + (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (equal (get-text-property handle2-location 'help-echo byline) + "Browse user profile of @acct43@example.space")))))) (ert-deftest mastodon-tl--byline-reblogged-with-avatars () "Should format the reblogged toot correctly." @@ -383,19 +383,19 @@ a string or a numeric." (timestamp (cdr (assoc 'created_at toot))) (original-timestamp (cdr (assoc 'created_at original-toot)))) (with-mock - ;; We don't expect to use the toot's timestamp but the timestamp of the - ;; reblogged toot: - (stub create-image => '(image "fake data")) - (mock (date-to-time timestamp) => '(1 2)) - (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") - (mock (date-to-time original-timestamp) => '(3 4)) - (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - "Account 42 (@acct42@example.space) + ;; We don't expect to use the toot's timestamp but the timestamp of the + ;; reblogged toot: + (stub create-image => '(image "fake data")) + (mock (date-to-time timestamp) => '(1 2)) + (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") + (mock (date-to-time original-timestamp) => '(3 4)) + (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + "Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ "))))) @@ -408,17 +408,17 @@ a string or a numeric." (timestamp (cdr (assoc 'created_at toot))) (original-timestamp (cdr (assoc 'created_at original-toot)))) (with-mock - ;; We don't expect to use the toot's timestamp but the timestamp of the - ;; reblogged toot: - (mock (date-to-time timestamp) => '(1 2)) - (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") - (mock (date-to-time original-timestamp) => '(3 4)) - (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") - - (should (string= (substring-no-properties - (mastodon-tl--byline toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) + ;; We don't expect to use the toot's timestamp but the timestamp of the + ;; reblogged toot: + (mock (date-to-time timestamp) => '(1 2)) + (mock (format-time-string mastodon-toot-timestamp-format '(1 2)) => "reblogging time") + (mock (date-to-time original-timestamp) => '(3 4)) + (mock (format-time-string mastodon-toot-timestamp-format '(3 4)) => "original time") + + (should (string= (substring-no-properties + (mastodon-tl--byline toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) "(B) (F) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time ------------ @@ -429,17 +429,17 @@ a string or a numeric." (let ((mastodon-tl--show-avatars-p nil) (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) (with-mock - (mock (date-to-time timestamp) => '(22782 21551)) - (mock (current-time) => '(22782 22000)) - (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") - - (let* ((formatted-string (mastodon-tl--byline mastodon-tl-test-base-toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) - (timestamp-start (string-match "2999-99-99" formatted-string)) - (properties (text-properties-at timestamp-start formatted-string))) - (should (equal '(22782 21551) (plist-get properties 'timestamp))) - (should (string-equal "7 minutes ago" (plist-get properties 'display))))))) + (mock (date-to-time timestamp) => '(22782 21551)) + (mock (current-time) => '(22782 22000)) + (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + + (let* ((formatted-string (mastodon-tl--byline mastodon-tl-test-base-toot + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) + (timestamp-start (string-match "2999-99-99" formatted-string)) + (properties (text-properties-at timestamp-start formatted-string))) + (should (equal '(22782 21551) (plist-get properties 'timestamp))) + (should (string-equal "7 minutes ago" (plist-get properties 'display))))))) (ert-deftest mastodon-tl--consider-timestamp-for-updates-no-active-callback () "Should update the timestamp update variables as expected." @@ -454,33 +454,33 @@ a string or a numeric." ;; something a later update doesn't update: (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (null mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) + (should (null mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) ;; something only shortly sooner doesn't update: (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" (time-subtract long-in-the-future (seconds-to-time 9)))) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" (time-subtract long-in-the-future (seconds-to-time 9)))) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (null mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) + (should (null mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) ;; something much sooner, does update (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" soon-in-the-future)) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" soon-in-the-future)) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (null mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) + (should (null mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) ))) (ert-deftest mastodon-tl--consider-timestamp-for-updates-with-active-callback () @@ -496,27 +496,27 @@ a string or a numeric." ;; something a later update doesn't update: (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100)))) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (eq 'initial-timer mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) + (should (eq 'initial-timer mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update long-in-the-future))) ;; something much sooner, does update (with-mock - (mock (mastodon-tl--relative-time-details 'fake-timestamp) => - (cons "xxx ago" soon-in-the-future)) - (mock (cancel-timer 'initial-timer)) - (mock (run-at-time soon-in-the-future nil - #'mastodon-tl--update-timestamps-callback - (current-buffer) nil) => 'new-timer) + (mock (mastodon-tl--relative-time-details 'fake-timestamp) => + (cons "xxx ago" soon-in-the-future)) + (mock (cancel-timer 'initial-timer)) + (mock (run-at-time soon-in-the-future nil + #'mastodon-tl--update-timestamps-callback + (current-buffer) nil) => 'new-timer) - (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) + (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp) - (should (eq 'new-timer mastodon-tl--timestamp-update-timer)) - (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) + (should (eq 'new-timer mastodon-tl--timestamp-update-timer)) + (should (eq mastodon-tl--timestamp-next-update soon-in-the-future))) ))) (ert-deftest mastodon-tl--find-property-range--no-tag () @@ -769,45 +769,45 @@ constant." (let ((now (current-time)) markers) (cl-labels ((insert-timestamp (n) - (insert (format "\nSome text before timestamp %s:" n)) - (insert (propertize - (format "timestamp #%s" n) - 'timestamp (time-subtract now (seconds-to-time (* 60 n))) - 'display (format "unset %s" n))) - (push (copy-marker (point)) markers) - (insert " some more text."))) + (insert (format "\nSome text before timestamp %s:" n)) + (insert (propertize + (format "timestamp #%s" n) + 'timestamp (time-subtract now (seconds-to-time (* 60 n))) + 'display (format "unset %s" n))) + (push (copy-marker (point)) markers) + (insert " some more text."))) (with-temp-buffer (cl-dotimes (n 12) (insert-timestamp (+ n 2))) (setq markers (nreverse markers)) (with-mock - (mock (current-time) => now) - (stub run-at-time => 'fake-timer) - - ;; make the initial call - (mastodon-tl--update-timestamps-callback (current-buffer) nil) - (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" - "unset 7" "unset 8" "unset 9" "unset 10" "unset 11" "unset 12" "unset 13") - (tl-tests--property-values-at 'display - (tl-tests--all-regions-with-property 'timestamp)))) - - ;; fake the follow-up call - (mastodon-tl--update-timestamps-callback (current-buffer) (nth 4 markers)) - (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" - "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" - "unset 12" "unset 13") - (tl-tests--property-values-at 'display - (tl-tests--all-regions-with-property 'timestamp)))) - (should (null (marker-position (nth 4 markers)))) - - ;; fake the follow-up call - (mastodon-tl--update-timestamps-callback (current-buffer) (nth 9 markers)) - (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" - "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" - "12 minutes ago" "13 minutes ago") - (tl-tests--property-values-at 'display - (tl-tests--all-regions-with-property 'timestamp)))) - (should (null (marker-position (nth 9 markers))))))))) + (mock (current-time) => now) + (stub run-at-time => 'fake-timer) + + ;; make the initial call + (mastodon-tl--update-timestamps-callback (current-buffer) nil) + (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" + "unset 7" "unset 8" "unset 9" "unset 10" "unset 11" "unset 12" "unset 13") + (tl-tests--property-values-at 'display + (tl-tests--all-regions-with-property 'timestamp)))) + + ;; fake the follow-up call + (mastodon-tl--update-timestamps-callback (current-buffer) (nth 4 markers)) + (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" + "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" + "unset 12" "unset 13") + (tl-tests--property-values-at 'display + (tl-tests--all-regions-with-property 'timestamp)))) + (should (null (marker-position (nth 4 markers)))) + + ;; fake the follow-up call + (mastodon-tl--update-timestamps-callback (current-buffer) (nth 9 markers)) + (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago" + "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago" + "12 minutes ago" "13 minutes ago") + (tl-tests--property-values-at 'display + (tl-tests--all-regions-with-property 'timestamp)))) + (should (null (marker-position (nth 9 markers))))))))) (ert-deftest mastodon-tl--has-spoiler () "Should be able to detect toots with spoiler text as expected" @@ -925,13 +925,13 @@ constant." (ert-deftest mastodon-tl--extract-hashtag-from-url-wrong-instance () (should (null (mastodon-tl--extract-hashtag-from-url - "https://example.org/tags/foo" - "https://other.example.org")))) + "https://example.org/tags/foo" + "https://other.example.org")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-not-tag () (should (null (mastodon-tl--extract-hashtag-from-url - "https://example.org/@userid" - "https://example.org")))) + "https://example.org/@userid" + "https://example.org")))) (ert-deftest mastodon-tl--userhandles () "Should recognise iserhandles in a toot and add the required properties to it." diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 06da870..abc66d0 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -41,6 +41,6 @@ (ert-deftest cancel () (with-mock - (mock (kill-buffer-and-window)) - (mastodon-toot--cancel) - (mock-verify))) + (mock (kill-buffer-and-window)) + (mastodon-toot--cancel) + (mock-verify))) -- cgit v1.2.3 From d0bf4f196a9a30ea4e19b0b6fa5f9c5bfaf695b3 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Tue, 2 Nov 2021 21:25:18 +0100 Subject: Convert most uses of `(cdr (assoc ))` to `(alist-get )` This is more readable and actually more efficient (maybe) since it uses `eq` rather than `equal` as a test. --- lisp/mastodon-async.el | 2 +- lisp/mastodon-auth.el | 10 ++--- lisp/mastodon-http.el | 10 ++--- lisp/mastodon-notifications.el | 30 +++++++-------- lisp/mastodon-profile.el | 62 +++++++++++++++--------------- lisp/mastodon-search.el | 26 ++++++------- lisp/mastodon-tl.el | 87 +++++++++++++++++++++--------------------- lisp/mastodon-toot.el | 64 +++++++++++++++---------------- 8 files changed, 145 insertions(+), 146 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 1fabee2..1fee9ef 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -305,7 +305,7 @@ Filter the toots using FILTER." "Test JSON to see if account is local." (not (string-match-p "@" - (cdr (assoc 'acct (cdr (assoc 'account json))))))) + (alist-get 'acct (alist-get 'account json))))) (defun mastodon-async--output-toot (toot) "Process TOOT and prepend it to the async user-facing buffer." diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index b22b51e..e5767f1 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -158,11 +158,11 @@ Handle any errors from the server." (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"))))) + (alist-get + 'acct + (mastodon-http--get-json + (mastodon-http--api + "accounts/verify_credentials")))) (defun mastodon-auth--user-acct () "Return a mastodon user acct name." diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 3e27e13..a45b4ed 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -88,7 +88,7 @@ Message status and JSON error from RESPONSE if unsuccessful." (progn (switch-to-buffer response) (let ((json-response (mastodon-http--process-json))) - (message "Error %s: %s" status (cdr (assoc 'error json-response)))))))) + (message "Error %s: %s" status (alist-get 'error json-response))))))) (defun mastodon-http--read-file-as-string (filename) "Read a file FILENAME as a string. Used to generate image preview." @@ -267,13 +267,13 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." (lambda (&key data &allow-other-keys) (when data (progn - (push (cdr (assoc 'id data)) + (push (alist-get 'id data) mastodon-toot--media-attachment-ids) ; add ID to list (message "%s file %s with id %S and caption '%s' uploaded!" - (capitalize (cdr (assoc 'type data))) + (capitalize (alist-get 'type data)) file - (cdr (assoc 'id data)) - (cdr (assoc 'description data))) + (alist-get 'id data) + (alist-get 'description data)) (mastodon-toot--update-status-fields))))) :error (cl-function (lambda (&key error-thrown &allow-other-keys) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 2430bcc..4437635 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -78,12 +78,12 @@ (interactive) (when (mastodon-tl--find-property-range 'toot-json (point)) (let* ((toot-json (mastodon-tl--property 'toot-json)) - (f-req-p (string= "follow_request" (cdr (assoc 'type toot-json))))) + (f-req-p (string= "follow_request" (alist-get 'type toot-json)))) (if f-req-p - (let* ((account (cdr (assoc 'account toot-json))) - (id (cdr (assoc 'id account))) - (handle (cdr (assoc 'acct account))) - (name (cdr (assoc 'username account)))) + (let* ((account (alist-get 'account toot-json)) + (id (alist-get 'id account)) + (handle (alist-get 'acct account)) + (name (alist-get 'username account))) (if id (let ((response (mastodon-http--post @@ -104,12 +104,12 @@ (interactive) (when (mastodon-tl--find-property-range 'toot-json (point)) (let* ((toot-json (mastodon-tl--property 'toot-json)) - (f-req-p (string= "follow_request" (cdr (assoc 'type toot-json))))) + (f-req-p (string= "follow_request" (alist-get 'type toot-json)))) (if f-req-p - (let* ((account (cdr (assoc 'account toot-json))) - (id (cdr (assoc 'id account))) - (handle (cdr (assoc 'acct account))) - (name (cdr (assoc 'username account)))) + (let* ((account (alist-get 'account toot-json)) + (id (alist-get 'id account)) + (handle (alist-get 'acct account)) + (name (alist-get 'username account))) (if id (let ((response (mastodon-http--post @@ -127,7 +127,7 @@ (defun mastodon-notifications--mention (note) "Format for a `mention' NOTE." - (let ((id (cdr (assoc 'id note))) + (let ((id (alist-get 'id note)) (status (mastodon-tl--field 'status note))) (mastodon-notifications--insert-status status @@ -156,8 +156,8 @@ (defun mastodon-notifications--follow-request (note) "Format for a `follow-request' NOTE." - (let ((id (cdr (assoc 'id note))) - (follower (cdr (assoc 'username (cdr (assoc 'account note)))))) + (let ((id (alist-get 'id note)) + (follower (alist-get 'username (alist-get 'account note)))) (mastodon-notifications--insert-status (cons '(reblog (id . nil)) note) (propertize (format "You have a follow request from... %s" follower) @@ -170,7 +170,7 @@ (defun mastodon-notifications--favourite (note) "Format for a `favourite' NOTE." - (let ((id (cdr (assoc 'id note))) + (let ((id (alist-get 'id note)) (status (mastodon-tl--field 'status note))) (mastodon-notifications--insert-status status @@ -188,7 +188,7 @@ (defun mastodon-notifications--reblog (note) "Format for a `boost' NOTE." - (let ((id (cdr (assoc 'id note))) + (let ((id (alist-get 'id note)) (status (mastodon-tl--field 'status note))) (mastodon-notifications--insert-status status diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index b68be6f..c4bec38 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -163,9 +163,9 @@ extra keybindings." (interactive) (if (mastodon-tl--find-property-range 'toot-json (point)) (let* ((acct-json (mastodon-profile--toot-json)) - (id (cdr (assoc 'id acct-json))) - (handle (cdr (assoc 'acct acct-json))) - (name (cdr (assoc 'username acct-json)))) + (id (alist-get 'id acct-json)) + (handle (alist-get 'acct acct-json)) + (name (alist-get 'username acct-json))) (if id (let ((response (mastodon-http--post @@ -185,9 +185,9 @@ extra keybindings." (interactive) (if (mastodon-tl--find-property-range 'toot-json (point)) (let* ((acct-json (mastodon-profile--toot-json)) - (id (cdr (assoc 'id acct-json))) - (handle (cdr (assoc 'acct acct-json))) - (name (cdr (assoc 'username acct-json)))) + (id (alist-get 'id acct-json)) + (handle (alist-get 'acct acct-json)) + (name (alist-get 'username acct-json))) (if id (let ((response (mastodon-http--post @@ -209,8 +209,8 @@ extra keybindings." "/api/v1/accounts/update_credentials")) ;; (buffer (mastodon-http--patch url)) (json (mastodon-http--patch-json url)) - (source (cdr (assoc 'source json))) - (note (cdr (assoc 'note source))) + (source (alist-get 'source json)) + (note (alist-get 'note source)) (buffer (get-buffer-create "*mastodon-update-profile*")) (inhibit-read-only t)) (switch-to-buffer-other-window buffer) @@ -247,8 +247,8 @@ Returns a list of lists." (mapcar (lambda (el) (list - (cdr (assoc 'name el)) - (cdr (assoc 'value el)))) + (alist-get 'name el) + (alist-get 'value el))) fields)))) (defun mastodon-profile--fields-insert (fields) @@ -306,10 +306,10 @@ Returns a list of lists." (mastodon-profile--account-field account 'statuses_count))) (relationships (mastodon-profile--relationships-get id)) - (followed-by-you (cdr (assoc 'following - (aref relationships 0)))) - (follows-you (cdr (assoc 'followed_by - (aref relationships 0)))) + (followed-by-you (alist-get 'following + (aref relationships 0))) + (follows-you (alist-get 'followed_by + (aref relationships 0))) (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) (pinned (mastodon-profile--get-statuses-pinned account))) @@ -396,11 +396,11 @@ Returns a list of lists." If toot is a boost, opens the profile of the booster." (interactive) (mastodon-profile--make-author-buffer - (cdr (assoc 'account (mastodon-profile--toot-json))))) + (alist-get '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)))) + (let ((url (alist-get 'avatar_static status))) (unless (equal url "/avatars/original/missing.png") (mastodon-media--get-media-link-rendering url)))) @@ -443,12 +443,12 @@ FIELD is used to identify regions under 'account" (propertize (mastodon-tl--byline-author `((account . ,toot))) 'byline 't - 'toot-id (cdr (assoc 'id toot)) + 'toot-id (alist-get '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) + (mastodon-tl--render-text (alist-get 'note toot) nil) "\n"))) tootv))) @@ -461,7 +461,7 @@ If the handle does not match a search return then retun NIL." handle)) (matching-account (seq-remove - (lambda(x) (not (string= (cdr (assoc 'acct x)) handle))) + (lambda(x) (not (string= (alist-get 'acct x) handle))) (mastodon-http--get-json (mastodon-http--api (format "accounts/search?q=%s" handle)))))) (when (equal 1 (length matching-account)) @@ -477,35 +477,35 @@ If the handle does not match a search return then retun NIL." These include the author, author of reblogged entries and any user mentioned." (when status - (let ((this-account (cdr (assoc 'account status))) - (mentions (cdr (assoc 'mentions status))) - (reblog (cdr (assoc 'reblog status)))) + (let ((this-account (alist-get 'account status)) + (mentions (alist-get 'mentions status)) + (reblog (alist-get 'reblog status))) (seq-filter 'stringp (seq-uniq (seq-concatenate 'list - (list (cdr (assoc 'acct this-account))) + (list (alist-get 'acct this-account)) (mastodon-profile--extract-users-handles reblog) (mapcar (lambda (mention) - (cdr (assoc 'acct mention))) + (alist-get '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))))) + (let* ((this-account (alist-get 'account status)) + (reblog-account (alist-get 'account (alist-get 'reblog status))) (mention-id (seq-some (lambda (mention) (when (string= handle - (cdr (assoc 'acct mention))) - (cdr (assoc 'id mention)))) - (cdr (assoc 'mentions status))))) + (alist-get 'acct mention)) + (alist-get 'id mention))) + (alist-get 'mentions status)))) (cond ((string= handle - (cdr (assoc 'acct this-account))) + (alist-get 'acct this-account)) this-account) ((string= handle - (cdr (assoc 'acct reblog-account))) + (alist-get 'acct reblog-account)) reblog-account) (mention-id (mastodon-profile--account-from-id mention-id)) diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index cbb452d..fcfaec9 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -72,9 +72,9 @@ Returns a nested list containing user handle, display name, and URL." (let* ((url (format "%s/api/v2/search" mastodon-instance-url)) (buffer (format "*mastodon-search-%s*" query)) (response (mastodon-http--get-search-json url query)) - (accts (cdr (assoc 'accounts response))) - (tags (cdr (assoc 'hashtags response))) - (statuses (cdr (assoc 'statuses response))) + (accts (alist-get 'accounts response)) + (tags (alist-get 'hashtags response)) + (statuses (alist-get 'statuses response)) (user-ids (mapcar #'mastodon-search--get-user-info accts)) ; returns a list of three-item lists (tags-list (mapcar #'mastodon-search--get-hashtag-info @@ -136,27 +136,27 @@ Returns a nested list containing user handle, display name, and URL." (defun mastodon-search--get-user-info (account) "Get user handle, display name and account URL from ACCOUNT." - (list (cdr (assoc 'display_name account)) - (cdr (assoc 'acct account)) - (cdr (assoc 'url account)))) + (list (alist-get 'display_name account) + (alist-get 'acct account) + (alist-get 'url account))) (defun mastodon-search--get-hashtag-info (tag) "Get hashtag name and URL from TAG." - (list (cdr (assoc 'name tag)) - (cdr (assoc 'url tag)))) + (list (alist-get 'name tag) + (alist-get 'url tag))) (defun mastodon-search--get-status-info (status) "Get ID, timestamp, content, and spoiler from STATUS." - (list (cdr (assoc 'id status)) - (cdr (assoc 'created_at status)) - (cdr (assoc 'spoiler_text status)) - (cdr (assoc 'content status)))) + (list (alist-get 'id status) + (alist-get 'created_at status) + (alist-get 'spoiler_text status) + (alist-get 'content status))) (defun mastodon-search--get-id-from-status (status) "Fetch the id from a STATUS returned by a search call to the server. We use this to fetch the complete status from the server." - (cdr (assoc 'id status))) + (alist-get 'id status)) (defun mastodon-search--fetch-full-status-from-id (id) "Fetch the full status with id ID from the server. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index d300a09..cf1c326 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -266,13 +266,13 @@ Optionally start from POS." (defun mastodon-tl--byline-author (toot) "Propertize author of TOOT." - (let* ((account (cdr (assoc 'account toot))) - (handle (cdr (assoc 'acct account))) - (name (if (not (string= "" (cdr (assoc 'display_name account)))) - (cdr (assoc 'display_name account)) - (cdr (assoc 'username account)))) - (profile-url (cdr (assoc 'url account))) - (avatar-url (cdr (assoc 'avatar account)))) + (let* ((account (alist-get 'account toot)) + (handle (alist-get 'acct account)) + (name (if (not (string= "" (alist-get 'display_name account))) + (alist-get 'display_name account) + (alist-get 'username account))) + (profile-url (alist-get 'url account)) + (avatar-url (alist-get '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 @@ -298,7 +298,7 @@ Optionally start from POS." (defun mastodon-tl--byline-boosted (toot) "Add byline for boosted data from TOOT." - (let ((reblog (cdr (assoc 'reblog toot)))) + (let ((reblog (alist-get 'reblog toot))) (when reblog (concat "\n " @@ -310,8 +310,8 @@ Optionally start from POS." "Return FIELD from TOOT. Return value from boosted content if available." - (or (cdr (assoc field (cdr (assoc 'reblog toot)))) - (cdr (assoc field toot)))) + (or (alist-get field (alist-get 'reblog toot)) + (alist-get field toot))) (defun mastodon-tl--relative-time-details (timestamp &optional current-time) "Return cons of (descriptive string . next change) for the TIMESTAMP. @@ -502,14 +502,14 @@ START and END are the boundaries of the link in the toot." (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)) + (let* ((mentions (append (alist-get 'mentions toot) nil)) (mention (pop mentions)) (short-acct (substring acct 1 (length acct))) return) (while mention - (when (string= (cdr (assoc 'acct mention)) + (when (string= (alist-get 'acct mention) short-acct) - (setq return (cdr (assoc 'id mention)))) + (setq return (alist-get 'id mention))) (setq mention (pop mentions))) return)) @@ -671,12 +671,12 @@ message is a link which unhides/hides the main body." (media-string (mapconcat (lambda (media-attachement) (let ((preview-url - (cdr (assoc 'preview_url media-attachement))) + (alist-get 'preview_url media-attachement)) (remote-url - (if (cdr (assoc 'remote_url media-attachement)) - (cdr (assoc 'remote_url media-attachement)) + (if (alist-get 'remote_url media-attachement) + (alist-get 'remote_url media-attachement) ;; fallback b/c notifications don't have remote_url - (cdr (assoc 'url media-attachement))))) + (alist-get 'url media-attachement)))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering preview-url remote-url) ; 2nd arg for shr-browse-url @@ -690,10 +690,10 @@ message is a link which unhides/hides the main body." (defun mastodon-tl--content (toot) "Retrieve text content from TOOT." (let* ((content (mastodon-tl--field 'content toot)) - (reblog (cdr (assoc 'reblog toot))) + (reblog (alist-get 'reblog toot)) (poll-p (if reblog - (cdr (assoc 'poll reblog)) - (cdr (assoc 'poll toot))))) + (alist-get 'poll reblog) + (alist-get 'poll toot)))) (concat (when poll-p (mastodon-tl--get-poll toot)) @@ -718,18 +718,17 @@ takes a single function. By default it is body " \n" (mastodon-tl--byline toot author-byline action-byline)) - 'toot-id (cdr (assoc 'id toot)) + 'toot-id (alist-get 'id toot) 'base-toot-id (mastodon-tl--toot-id toot) 'help-echo (when (and mastodon-tl--buffer-spec (string-match-p "context" ; when thread view (plist-get mastodon-tl--buffer-spec 'endpoint))) - (if (alist-get 'reblog toot) - (let ((reblog (cdr (assoc 'reblog toot)))) - (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count reblog) - (alist-get 'reblogs_count reblog) - (alist-get 'replies_count reblog))) + (if-let ((reblog (alist-get 'reblog toot))) + (format "%s faves | %s boosts | %s replies" + (alist-get 'favourites_count reblog) + (alist-get 'reblogs_count reblog) + (alist-get 'replies_count reblog)) (format "%s faves | %s boosts | %s replies" (alist-get 'favourites_count toot) (alist-get 'reblogs_count toot) @@ -749,8 +748,8 @@ takes a single function. By default it is (progn (format "Option %s: %s, %s votes.\n" (setq option-counter (1+ option-counter)) - (cdr (assoc 'title option)) - (cdr (assoc 'votes_count option))))) + (alist-get 'title option) + (alist-get 'votes_count option)))) options "\n") "\n"))) @@ -759,12 +758,12 @@ takes a single function. By default it is (interactive (list (let* ((toot (mastodon-tl--property 'toot-json)) - (reblog (cdr (assoc 'reblog toot))) - (poll (or (cdr (assoc 'poll reblog)) + (reblog (alist-get 'reblog toot)) + (poll (or (alist-get 'poll reblog) (mastodon-tl--field 'poll toot))) (options (mastodon-tl--field 'options poll)) (options-titles (mapcar (lambda (x) - (cdr (assoc 'title x))) + (alist-get 'title x)) options)) (options-number-seq (number-sequence 1 (length options))) (options-numbers (mapcar (lambda(x) @@ -790,7 +789,7 @@ takes a single function. By default it is (message "No poll here.") (let* ((toot (mastodon-tl--property 'toot-json)) (poll (mastodon-tl--field 'poll toot)) - (poll-id (cdr (assoc 'id poll))) + (poll-id (alist-get 'id poll)) (url (mastodon-http--api (format "polls/%s/votes" poll-id))) ;; need to zero-index our option: (option-as-arg (number-to-string (1- (string-to-number (car option))))) @@ -916,9 +915,9 @@ 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))) + (let ((id (alist-get 'id json)) + (reblog (alist-get 'reblog json))) + (if reblog (alist-get 'id reblog) id))) (defun mastodon-tl--thread () @@ -930,10 +929,10 @@ webapp" (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)))) + (when (member (alist-get 'type toot) '("reblog" "favourite")) + (setq toot (alist-get 'status toot))) + (if (> (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))) 0) (with-output-to-temp-buffer buffer (switch-to-buffer buffer) @@ -945,9 +944,9 @@ webapp" (lambda(toot) (message "END of thread.")))) (let ((inhibit-read-only t)) (mastodon-tl--timeline (vconcat - (cdr (assoc 'ancestors context)) + (alist-get 'ancestors context) `(,toot) - (cdr (assoc 'descendants context)))))) + (alist-get 'descendants context))))) (message "No Thread!")))) (defun mastodon-tl--follow-user (user-handle) @@ -1025,7 +1024,7 @@ webapp" (let* ((mutes-url (mastodon-http--api (format "mutes"))) (mutes-json (mastodon-http--get-json mutes-url)) (muted-accts (mapcar (lambda (muted) - (cdr (assoc 'acct muted))) + (alist-get 'acct muted)) mutes-json))) (completing-read "Handle of user to unmute: " muted-accts @@ -1074,7 +1073,7 @@ webapp" (let* ((blocks-url (mastodon-http--api (format "blocks"))) (blocks-json (mastodon-http--get-json blocks-url)) (blocked-accts (mapcar (lambda (blocked) - (cdr (assoc 'acct blocked))) + (alist-get 'acct blocked)) blocks-json))) (completing-read "Handle of user to unblock: " blocked-accts diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 22eb626..9acdb2a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -155,7 +155,7 @@ Valid values are \"direct\", \"private\" (followers-only), \"unlisted\", and \"p "Set max_toot_chars returned in JSON-RESPONSE and display in new toot buffer." (setq mastodon-toot--max-toot-chars (number-to-string - (cdr (assoc 'max_toot_chars json-response)))) + (alist-get 'max_toot_chars json-response))) (with-current-buffer "*new toot*" (mastodon-toot--update-status-fields))) @@ -246,11 +246,11 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (pinnable-p (and - (not (cdr (assoc 'reblog toot))) - (equal (cdr (assoc 'acct - (cdr (assoc 'account toot)))) + (not (alist-get 'reblog toot)) + (equal (alist-get 'acct + (alist-get 'account toot)) (mastodon-auth--user-acct)))) - (pinned-p (equal (cdr (assoc 'pinned toot)) t)) + (pinned-p (equal (alist-get 'pinned toot) t)) (action (if pinned-p "unpin" "pin")) (msg (if pinned-p "unpinned" "pinned")) (msg-y-or-n (if pinned-p "Unpin" "Pin"))) @@ -266,8 +266,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (url (if (mastodon-tl--field 'reblog toot) - (cdr (assoc 'url (cdr (assoc 'reblog toot)))) - (cdr (assoc 'url toot))))) + (alist-get 'url (alist-get 'reblog toot)) + (alist-get 'url toot)))) (kill-new url) (message "Toot URL copied to the clipboard."))) @@ -277,9 +277,9 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) (url (mastodon-http--api (format "statuses/%s" id)))) - (if (or (cdr (assoc 'reblog toot)) - (not (equal (cdr (assoc 'acct - (cdr (assoc 'account toot)))) + (if (or (alist-get 'reblog toot) + (not (equal (alist-get 'acct + (alist-get 'account toot)) (mastodon-auth--user-acct)))) (message "You can only delete your own toots.") (if (y-or-n-p (format "Delete this toot? ")) @@ -296,12 +296,12 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) (url (mastodon-http--api (format "statuses/%s" id))) - (toot-cw (cdr (assoc 'spoiler_text toot))) - (toot-visibility (cdr (assoc 'visibility toot))) - (reply-id (cdr (assoc 'in_reply_to_id toot)))) - (if (or (cdr (assoc 'reblog toot)) - (not (equal (cdr (assoc 'acct - (cdr (assoc 'account toot)))) + (toot-cw (alist-get 'spoiler_text toot)) + (toot-visibility (alist-get 'visibility toot)) + (reply-id (alist-get 'in_reply_to_id toot))) + (if (or (alist-get 'reblog toot) + (not (equal (alist-get 'acct + (alist-get 'account toot)) (mastodon-auth--user-acct)))) (message "You can only delete and redraft your own toots.") (if (y-or-n-p (format "Delete and redraft this toot? ")) @@ -311,8 +311,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (lambda () (with-current-buffer response (let* ((json-response (mastodon-http--process-json)) - (content (cdr (assoc 'text json-response)))) - ;; (media (cdr (assoc 'media_attachments json-response)))) + (content (alist-get 'text json-response))) + ;; (media (alist-get 'media_attachments json-response))) (mastodon-toot--compose-buffer nil nil) (goto-char (point-max)) (insert content) @@ -330,7 +330,7 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (bookmarked (cdr (assoc 'bookmarked toot))) + (bookmarked (alist-get 'bookmarked toot)) (url (mastodon-http--api (if (equal bookmarked t) (format "statuses/%s/unbookmark" id) (format "statuses/%s/bookmark" id)))) @@ -498,10 +498,10 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (let* ((boosted (mastodon-tl--field 'reblog status)) (mentions (if boosted - (cdr (assoc 'mentions (cdr (assoc 'reblog status)))) - (cdr (assoc 'mentions status))))) + (alist-get 'mentions (alist-get 'reblog status)) + (alist-get 'mentions status)))) (mapconcat (lambda(x) (mastodon-toot--process-local - (cdr (assoc 'acct x)))) + (alist-get 'acct x))) ;; reverse does not work on vectors in 24.5 (reverse (append mentions nil)) ""))) @@ -554,12 +554,12 @@ The prefix can match against both user handles and display names." (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))) + (user (alist-get 'acct account)) (mentions (mastodon-toot--mentions toot)) (boosted (mastodon-tl--field 'reblog toot)) (booster (when boosted - (cdr (assoc 'acct - (cdr (assoc 'account toot))))))) + (alist-get 'acct + (alist-get 'account toot))))) (mastodon-toot (when user (if booster (if (and @@ -634,8 +634,8 @@ The items' ids are added to `mastodon-toot--media-attachment-ids', which are used to attach them to a toot after uploading." (mapcar (lambda (attachment) (let* ((filename (expand-file-name - (cdr (assoc :filename attachment)))) - (caption (cdr (assoc :description attachment))) + (alist-get :filename attachment))) + (caption (alist-get :description attachment)) (url (concat mastodon-instance-url "/api/v2/media"))) (message "Uploading %s..." (file-name-nondirectory filename)) (mastodon-http--post-media-attachment url filename caption))) @@ -659,14 +659,14 @@ which are used to attach them to a toot after uploading." (image-transforms-p)) `(:height ,mastodon-toot--attachment-height)))) (mapcan (lambda (attachment) - (let* ((data (cdr (assoc :contents attachment))) + (let* ((data (alist-get :contents attachment)) (image (apply #'create-image data (if (version< emacs-version "27.1") (when image-options 'imagemagick) nil) ; inbuilt scaling in 27.1 t image-options)) - (type (cdr (assoc :content-type attachment))) - (description (cdr (assoc :description attachment)))) + (type (alist-get :content-type attachment)) + (description (alist-get :description attachment))) (setq counter (1+ counter)) (list (format "\n %d: " counter) image @@ -787,8 +787,8 @@ on the status of NSFW, content warning flags, media attachments, etc." "If REPLY-TO-USER is provided, inject their handle into the message. If REPLY-TO-ID is provided, set `mastodon-toot--reply-to-id'. REPLY-JSON is the full JSON of the toot being replied to." - (let ((reply-visibility (cdr (assoc 'visibility reply-json))) - (reply-cw (cdr (assoc 'spoiler_text reply-json)))) + (let ((reply-visibility (alist-get 'visibility reply-json)) + (reply-cw (alist-get 'spoiler_text reply-json))) (when reply-to-user (insert (format "%s " reply-to-user)) (setq mastodon-toot--reply-to-id reply-to-id) -- cgit v1.2.3 From f67114cc6c5c167db7327b6b965839236e0466aa Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Fri, 5 Nov 2021 17:57:55 +0100 Subject: Use portable filename component functions. Apparently one should not rely on "/" being the directory separator and use the funtions from https://www.gnu.org/software/emacs/manual/html_node/elisp/File-Name-Components.html#File-Name-Components instead. The new version seems strictly better in that it won't create paths with double slashes when `emojify-emojis-dir` already ends in a slash. This also refines the test for `emojify-emojis-dir` to actually check it is an existing directoy and not just an existing file, dir, or symlink. --- lisp/mastodon-toot.el | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9acdb2a..d5f4d78 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -366,23 +366,25 @@ To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." (interactive) (let ((custom-emoji (mastodon-http--get-json (mastodon-http--api "custom_emojis"))) - (mastodon-custom-emoji-dir (concat (expand-file-name - emojify-emojis-dir) - "/mastodon-custom-emojis/"))) - (if (not (file-exists-p emojify-emojis-dir)) + (mastodon-custom-emoji-dir (file-name-as-directory + (concat (file-name-as-directory + (expand-file-name + emojify-emojis-dir)) + "mastodon-custom-emojis")))) + (if (not (file-directory-p emojify-emojis-dir)) (message "Looks like you need to set up emojify first.") (progn (unless (file-directory-p mastodon-custom-emoji-dir) (make-directory mastodon-custom-emoji-dir nil)) ; no add parent (mapc (lambda (x) - (url-copy-file (alist-get 'url x) - (concat - mastodon-custom-emoji-dir - (alist-get 'shortcode x) - "." - (file-name-extension (alist-get 'url x))) - t)) - custom-emoji) + (url-copy-file (alist-get 'url x) + (concat + mastodon-custom-emoji-dir + (alist-get 'shortcode x) + "." + (file-name-extension (alist-get 'url x))) + t)) + custom-emoji) (message "Custom emoji for %s downloaded to %s" mastodon-instance-url mastodon-custom-emoji-dir))))) -- cgit v1.2.3 From 65f80fd810793638beb6f146b25919bca5c21cfc Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Fri, 5 Nov 2021 18:33:16 +0100 Subject: Do a bit if `if` and `progn` sanitizing. - A `progn` with a single form is redundant - `when` doesn't need a `progn` body - `if` has an implicit `progn` for the consequences - I converted one cascade of `if`s into a `cond`. --- lisp/mastodon-async.el | 7 ++++--- lisp/mastodon-auth.el | 1 - lisp/mastodon-http.el | 24 +++++++++++------------- lisp/mastodon-profile.el | 11 +++++------ lisp/mastodon-toot.el | 29 ++++++++++++++--------------- 5 files changed, 34 insertions(+), 38 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 1fee9ef..524e13d 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -205,9 +205,10 @@ ENPOINT is the endpoint for the stream and timeline." mastodon-instance-url "*")) ;; if user stream, we need "timelines/home" not "timelines/user" ;; if notifs, we need "notifications" not "timelines/notifications" - (endpoint (if (equal name "notifications") "notifications" - (if (equal name "home") "timelines/home" - (format "timelines/%s" endpoint))))) + (endpoint (cond + ((equal name "notifications") "notifications") + ((equal name "home") "timelines/home") + (t (format "timelines/%s" endpoint))))) (mastodon-async--set-local-variables buffer-name http-buffer buffer-name queue-name) ;; Similar to timeline init. diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index e5767f1..8d0d7c6 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -136,7 +136,6 @@ Otherwise, generate a token and pass it to `mastodon-auth--handle-token-reponse'." (if-let ((token (cdr (assoc mastodon-instance-url mastodon-auth--token-alist)))) token - (mastodon-auth--handle-token-response (mastodon-auth--get-token)))) (defun mastodon-auth--handle-token-response (response) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index a45b4ed..1ec0dc0 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -85,10 +85,9 @@ Message status and JSON error from RESPONSE if unsuccessful." (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - (progn - (switch-to-buffer response) - (let ((json-response (mastodon-http--process-json))) - (message "Error %s: %s" status (alist-get 'error json-response))))))) + (switch-to-buffer response) + (let ((json-response (mastodon-http--process-json))) + (message "Error %s: %s" status (alist-get 'error json-response)))))) (defun mastodon-http--read-file-as-string (filename) "Read a file FILENAME as a string. Used to generate image preview." @@ -266,15 +265,14 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." :success (cl-function (lambda (&key data &allow-other-keys) (when data - (progn - (push (alist-get 'id data) - mastodon-toot--media-attachment-ids) ; add ID to list - (message "%s file %s with id %S and caption '%s' uploaded!" - (capitalize (alist-get 'type data)) - file - (alist-get 'id data) - (alist-get 'description data)) - (mastodon-toot--update-status-fields))))) + (push (alist-get 'id data) + mastodon-toot--media-attachment-ids) ; add ID to list + (message "%s file %s with id %S and caption '%s' uploaded!" + (capitalize (alist-get 'type data)) + file + (alist-get 'id data) + (alist-get 'description data)) + (mastodon-toot--update-status-fields)))) :error (cl-function (lambda (&key error-thrown &allow-other-keys) (cond diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index c4bec38..81ab837 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -349,12 +349,11 @@ Returns a list of lists." (mastodon-tl--render-text note account) ;; account here to enable tab-stops in profile note (if fields - (progn - (concat "\n" - (mastodon-tl--set-face - (mastodon-profile--fields-insert fields) - 'success) - "\n")) + (concat "\n" + (mastodon-tl--set-face + (mastodon-profile--fields-insert fields) + 'success) + "\n") "") ;; insert counts (mastodon-tl--set-face diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index d5f4d78..885db1d 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -373,21 +373,20 @@ To use the downloaded emoji, run `mastodon-toot--enable-custom-emoji'." "mastodon-custom-emojis")))) (if (not (file-directory-p emojify-emojis-dir)) (message "Looks like you need to set up emojify first.") - (progn - (unless (file-directory-p mastodon-custom-emoji-dir) - (make-directory mastodon-custom-emoji-dir nil)) ; no add parent - (mapc (lambda (x) - (url-copy-file (alist-get 'url x) - (concat - mastodon-custom-emoji-dir - (alist-get 'shortcode x) - "." - (file-name-extension (alist-get 'url x))) - t)) - custom-emoji) - (message "Custom emoji for %s downloaded to %s" - mastodon-instance-url - mastodon-custom-emoji-dir))))) + (unless (file-directory-p mastodon-custom-emoji-dir) + (make-directory mastodon-custom-emoji-dir nil)) ; no add parent + (mapc (lambda (x) + (url-copy-file (alist-get 'url x) + (concat + mastodon-custom-emoji-dir + (alist-get 'shortcode x) + "." + (file-name-extension (alist-get 'url x))) + t)) + custom-emoji) + (message "Custom emoji for %s downloaded to %s" + mastodon-instance-url + mastodon-custom-emoji-dir)))) (defun mastodon-toot--collect-custom-emoji () "Return a list of `mastodon-instance-url's custom emoji. -- cgit v1.2.3 From 4885cb1f3a564584eb90153051c0277c46f77ca4 Mon Sep 17 00:00:00 2001 From: mousebot Date: Tue, 9 Nov 2021 11:43:01 +0100 Subject: autocompletion ignores case of handles/display names --- lisp/mastodon-toot.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 885db1d..753a659 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -521,8 +521,8 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." The prefix can match against both user handles and display names." (let (res) (dolist (item (mastodon-search--search-accounts-query prefix)) - (when (or (string-prefix-p prefix (cadr item)) - (string-prefix-p prefix (car item))) + (when (or (string-prefix-p prefix (cadr item) t) + (string-prefix-p prefix (car item) t)) (push (mastodon-toot--mentions-company-make-candidate item) res))) res)) -- cgit v1.2.3 From f22cfa60d301a1b834cb86f6f9b75b57d9dab6e8 Mon Sep 17 00:00:00 2001 From: mousebot Date: Sun, 12 Dec 2021 10:41:35 +0100 Subject: rename company mentions to 'mastodon-toot-mentions' and fix matching for both user handle and user display name. --- lisp/mastodon-toot.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 753a659..9112fc9 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -519,9 +519,10 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--mentions-company-candidates (prefix) "Given a company PREFIX query, build a list of candidates. The prefix can match against both user handles and display names." - (let (res) + (let ((prefix (substring prefix 1)) ;remove @ for search + (res)) (dolist (item (mastodon-search--search-accounts-query prefix)) - (when (or (string-prefix-p prefix (cadr item) t) + (when (or (string-prefix-p prefix (substring (cadr item) 1) t) (string-prefix-p prefix (car item) t)) (push (mastodon-toot--mentions-company-make-candidate item) res))) res)) @@ -533,11 +534,11 @@ The prefix can match against both user handles and display names." (url (caddr candidate))) (propertize handle 'annot display-name 'meta url))) -(defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) +(defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) + (interactive (company-begin-backend 'mastodon-toot-mentions)) (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode (save-excursion (forward-whitespace -1) @@ -856,7 +857,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (when (require 'company nil :noerror) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) + (add-to-list 'company-backends 'mastodon-toot-mentions)) (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) -- cgit v1.2.3 From 2259577b8616005fd0265e211ae63188f4b32a3d Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 10:39:20 +0100 Subject: a first hack to make media uploads immediate and async. this commit moves the call to -upload-attached-media into -attach-media. upload-attached-media now uploads a single item only, whichever file has just been selected at the prompt. but we still use the list of attached-media to handle preview displays. --- lisp/mastodon-http.el | 2 +- lisp/mastodon-toot.el | 45 ++++++++++++++++++++++----------------------- 2 files changed, 23 insertions(+), 24 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1ec0dc0..a4f126f 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -261,7 +261,7 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." :parser 'json-read :headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) - :sync t + :sync nil :success (cl-function (lambda (&key data &allow-other-keys) (when data diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9112fc9..6eac981 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -446,10 +446,8 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. -If media items have been attached with -`mastodon-toot--attach-media', upload them with -`mastodon-toot-upload-attached-media' and attach them to the -toot." +If media items have been attached and uploaded with +`mastodon-toot--attach-media', they are attached to the toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) (empty-toot-p (and (not mastodon-toot--media-attachments) @@ -465,7 +463,8 @@ toot." (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mastodon-toot--upload-attached-media) ; sync upload so we wait (and pray) till done + ;; (mastodon-toot--upload-attached-media) + ;; moved upload to mastodon-toot--attach-media (mapcar (lambda (id) (cons "media_ids[]" id)) mastodon-toot--media-attachment-ids))) @@ -614,9 +613,10 @@ The prefix can match against both user handles and display names." (mastodon-toot--update-status-fields)) (defun mastodon-toot--attach-media (file content-type description) - "Prompt for a attachment FILE of CONTENT-TYPE with DESCRIPTION. -A preview is displayed in the toot create buffer, and the file -will be uploaded and attached to the toot upon sending." + "Prompt for an attachment FILE of CONTENT-TYPE with DESCRIPTION. +A preview is displayed in the new toot buffer, and the file +is uploaded asynchronously using `mastodon-toot--upload-attached-media'. +File is actually attached to the toot upon posting." (interactive "fFilename: \nsContent type: \nsDescription: ") (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. @@ -627,21 +627,20 @@ will be uploaded and attached to the toot upon sending." (:content-type . ,content-type) (:description . ,description) (:filename . ,file))))) - (mastodon-toot--refresh-attachments-display)) - -(defun mastodon-toot--upload-attached-media () - "Actually upload attachments using `mastodon-http--post-media-attachment'. -The files to be uploaded are in `mastodon-toot--media-attachments'. -The items' ids are added to `mastodon-toot--media-attachment-ids', -which are used to attach them to a toot after uploading." - (mapcar (lambda (attachment) - (let* ((filename (expand-file-name - (alist-get :filename attachment))) - (caption (alist-get :description attachment)) - (url (concat mastodon-instance-url "/api/v2/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) - (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments)))) + +(defun mastodon-toot--upload-attached-media (attachment) + "Upload a single attachment using `mastodon-http--post-media-attachment'. +The item's id is added to `mastodon-toot--media-attachment-ids', +which is used to attach it to a toot when posting." + (let* ((filename (expand-file-name + (alist-get :filename attachment))) + (caption (alist-get :description attachment)) + (url (concat mastodon-instance-url "/api/v2/media"))) + (message "Uploading %s..." (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption))) (defun mastodon-toot--refresh-attachments-display () "Update the display attachment previews in toot draft buffer." -- cgit v1.2.3 From f2af3a64967c403145c9b32aefd08ea8932a4770 Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 12:54:58 +0100 Subject: attach media test before post just test that length of --media-attachments == length of --media-attachment-ids. --- lisp/mastodon-toot.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6eac981..9a88bd5 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -463,11 +463,14 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments + (if (= (length mastodon-toot--media-attachments) + (length mastodon-toot--media-attachment-ids)) ;; (mastodon-toot--upload-attached-media) ;; moved upload to mastodon-toot--attach-media - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mapcar (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids) + (message "Looks like something went wrong with your uploads. Maybe you want to try again.")))) (args (append args-media args-no-media))) (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.") -- cgit v1.2.3 From 834dabcb9147e45633166b3f3b35b2b1d6fc64cc Mon Sep 17 00:00:00 2001 From: mousebot Date: Wed, 15 Dec 2021 21:16:24 +0100 Subject: customize option to enable custom emoji by default. --- lisp/mastodon-toot.el | 5 +++++ lisp/mastodon.el | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9112fc9..cb3cd44 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -106,6 +106,11 @@ This is only used if company mode is installed." (const :tag "following only" "following") (const :tag "all users" "all"))) +(defcustom mastodon-toot--enable-custom-instance-emoji nil + "Whether to enable your instance's custom emoji by default." + :group 'mastodon-toot + :type 'boolean) + (defvar-local mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") diff --git a/lisp/mastodon.el b/lisp/mastodon.el index f9c18a0..662b691 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -223,7 +223,9 @@ If REPLY-JSON is the json of the toot being replied to." ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () (when (require 'emojify nil :noerror) - (emojify-mode t)))) + (emojify-mode t) + (when mastodon-toot--enable-custom-instance-emoji + (mastodon-toot--enable-custom-emoji))))) (define-derived-mode mastodon-mode special-mode "Mastodon" "Major mode for Mastodon, the federated microblogging network." -- cgit v1.2.3 From 5288ffc54c50d41cddcd432a258ada3f7f882a93 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 12:58:33 +0100 Subject: fix media attachments test before posting if --media-attachments is non-nil, make sure we have non-nil media-args, and that we have same num of -ids to attach as attachments uploaded. --- lisp/mastodon-toot.el | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 9a88bd5..8953ee6 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -463,24 +463,27 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (if (= (length mastodon-toot--media-attachments) - (length mastodon-toot--media-attachment-ids)) - ;; (mastodon-toot--upload-attached-media) - ;; moved upload to mastodon-toot--attach-media (mapcar (lambda (id) (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids) - (message "Looks like something went wrong with your uploads. Maybe you want to try again.")))) + mastodon-toot--media-attachment-ids))) (args (append args-media args-no-media))) - (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) - (message "Looks like your toot is longer than that maximum allowed length.") - (if empty-toot-p - (message "Empty toot. Cowardly refusing to post this.") - (let ((response (mastodon-http--post endpoint args nil))) - (mastodon-http--triage response - (lambda () - (mastodon-toot--kill) - (message "Toot toot!")))))))) + (cond ((and mastodon-toot--media-attachments + ;; make sure we have media args + ;; and the same num of ids as attachments + (or (not args-media) + (not (= (length mastodon-toot--media-attachments) + (length mastodon-toot--media-attachment-ids))))) + (message "Something is wrong with your uploads. Wait for them to complete or try again.")) + ((> (length toot) (string-to-number mastodon-toot--max-toot-chars)) + (message "Looks like your toot is longer than that maximum allowed length.")) + (empty-toot-p + (message "Empty toot. Cowardly refusing to post this.")) + (t + (let ((response (mastodon-http--post endpoint args nil))) + (mastodon-http--triage response + (lambda () + (mastodon-toot--kill) + (message "Toot toot!")))))))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". -- cgit v1.2.3 From 469974fa74e1661ea0a60cb5249ee0d3c6f640fd Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 13:10:42 +0100 Subject: ensure media-attachment is not a dir --- lisp/mastodon-toot.el | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 71bd3ad..2ff7f83 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -632,15 +632,17 @@ File is actually attached to the toot upon posting." (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. (pop mastodon-toot--media-attachments)) - (setq mastodon-toot--media-attachments - (nconc mastodon-toot--media-attachments - `(((:contents . ,(mastodon-http--read-file-as-string file)) - (:content-type . ,content-type) - (:description . ,description) - (:filename . ,file))))) - (mastodon-toot--refresh-attachments-display) - ;; upload only most recent attachment: - (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments)))) + (if (file-directory-p file) + (message "Looks like you chose a directory not a file.") + (setq mastodon-toot--media-attachments + (nconc mastodon-toot--media-attachments + `(((:contents . ,(mastodon-http--read-file-as-string file)) + (:content-type . ,content-type) + (:description . ,description) + (:filename . ,file))))) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments))))) (defun mastodon-toot--upload-attached-media (attachment) "Upload a single attachment using `mastodon-http--post-media-attachment'. -- cgit v1.2.3 From fc8005c8fe3c5466c7e2d2b510e24f6eba661431 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 15:03:00 +0100 Subject: bump version, change homepage link, readme --- README.org | 2 +- lisp/mastodon-async.el | 4 ++-- lisp/mastodon-auth.el | 4 ++-- lisp/mastodon-client.el | 4 ++-- lisp/mastodon-discover.el | 4 ++-- lisp/mastodon-http.el | 4 ++-- lisp/mastodon-inspect.el | 4 ++-- lisp/mastodon-media.el | 4 ++-- lisp/mastodon-notifications.el | 4 ++-- lisp/mastodon-profile.el | 4 ++-- lisp/mastodon-search.el | 4 ++-- lisp/mastodon-tl.el | 4 ++-- lisp/mastodon-toot.el | 4 ++-- lisp/mastodon.el | 4 ++-- 14 files changed, 27 insertions(+), 27 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/README.org b/README.org index ab2dbff..fff4bc8 100644 --- a/README.org +++ b/README.org @@ -32,7 +32,7 @@ It adds the following features: | | images are links to the full image, can be zoomed/rotated/saved (see image keymap) | | | images scale properly | | | toot visibility (direct, followers only) icon appears in toot bylines | -| | display a toot's favorites, boosts and replies count in thread view | +| | display toot's number of favorites, boosts and replies | | | customize option to cache images | | Toots: | | | | mention booster in replies by default | diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 524e13d..3651bd5 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 8d0d7c6..8355200 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index bdfbca9..cb8eb26 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 33ce3d5..6b2eadf 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index a4f126f..00a0718 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1") (request "0.2.0")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index 57240f3..4d91948 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 457628f..bbab816 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 15633be..5efb7d4 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 7a9edc3..d21f5c0 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1") (seq "1.0")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index fcfaec9..a7dcda9 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen , martyhiatt -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 9355480..89604b5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 2ff7f83..c89acc7 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 662b691..2411e20 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.9.1 +;; Version: 0.9.2 ;; Package-Requires: ((emacs "26.1") (request "0.3.2") (seq "1.0")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. -- cgit v1.2.3 From 3a87f6caa62cbd0e925c765d2ac2840ba55f8db1 Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 16:22:46 +0100 Subject: depend on emacs 27.1, flychecks, docstrings, etc. strictly, the 27.1 dependency is only for proper-list-p in -http.el. --- lisp/mastodon-async.el | 25 +++++++++++++++---------- lisp/mastodon-auth.el | 2 +- lisp/mastodon-client.el | 2 +- lisp/mastodon-discover.el | 2 +- lisp/mastodon-http.el | 2 +- lisp/mastodon-inspect.el | 4 +++- lisp/mastodon-media.el | 2 +- lisp/mastodon-notifications.el | 2 +- lisp/mastodon-profile.el | 2 +- lisp/mastodon-search.el | 2 +- lisp/mastodon-tl.el | 2 +- lisp/mastodon-toot.el | 10 +++++++--- lisp/mastodon.el | 5 +++-- 13 files changed, 37 insertions(+), 25 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 3651bd5..77fdb8e 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. @@ -32,6 +32,8 @@ (require 'json) (require 'url-http) +(defvar url-http-end-of-headers) + (autoload 'mastodon-auth--access-token "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") @@ -153,10 +155,10 @@ NAME is the center portion of the buffer name for (url-retrieve url callback))) (defun mastodon-async--set-http-buffer (buffer http-buffer) - "Initializes for BUFFER a local variable `mastodon-async--http-buffer'. + "Initialize for BUFFER a local variable `mastodon-async--http-buffer'. HTTP-BUFFER is the initializing value. Use this funcion if HTTP-BUFFER -is not known when `mastodon-async--setup-buffer' is called." +is not known when `mastodon-async--setup-buffer' is called." (with-current-buffer (get-buffer-create buffer) (setq mastodon-async--http-buffer http-buffer))) @@ -164,6 +166,7 @@ is not known when `mastodon-async--setup-buffer' is called." http-buffer buffer-name queue-name) + "Set local variables for BUFFER, HTTP-BUFFER, BUFFER-NAME, and QUEUE-NAME." (with-current-buffer (get-buffer-create buffer) (let ((value mastodon-instance-url)) (make-local-variable 'mastodon-instance-url) @@ -173,7 +176,7 @@ is not known when `mastodon-async--setup-buffer' is called." (setq mastodon-async--queue queue-name))) (defun mastodon-async--setup-http (http-buffer name) - "Adds local variables to HTTP-BUFFER. + "Add local variables to HTTP-BUFFER. NAME is used to generate the display buffer and the queue." (let ((queue-name (concat " *mastodon-async-queue-" name "-" @@ -184,7 +187,8 @@ NAME is used to generate the display buffer and the queue." buffer-name queue-name))) (defun mastodon-async--setup-queue (http-buffer name) - "Sets up the buffer for the async queue." + "Set up HTTP-BUFFER buffer for the async queue. +NAME is used to generate the display buffer and the queue." (let ((queue-name (concat " *mastodon-async-queue-" name "-" mastodon-instance-url "*")) (buffer-name(concat "*mastodon-async-display-" name "-" @@ -194,11 +198,11 @@ NAME is used to generate the display buffer and the queue." queue-name)) (defun mastodon-async--setup-buffer (http-buffer name endpoint) - "Sets up the buffer timeline like `mastodon-tl--init'. + "Set up the buffer timeline like `mastodon-tl--init'. HTTP-BUFFER the name of the http-buffer, if unknown, set to... NAME is the name of the stream for the buffer name. -ENPOINT is the endpoint for the stream and timeline." +ENDPOINT is the endpoint for the stream and timeline." (let ((queue-name (concat " *mastodon-async-queue-" name "-" mastodon-instance-url "*")) (buffer-name (concat "*mastodon-async-display-" name "-" @@ -211,7 +215,7 @@ ENPOINT is the endpoint for the stream and timeline." (t (format "timelines/%s" endpoint))))) (mastodon-async--set-local-variables buffer-name http-buffer buffer-name queue-name) - ;; Similar to timeline init. + ;; Similar to timeline init. (with-current-buffer (get-buffer-create buffer-name) (setq inhibit-read-only t) ; for home timeline? (make-local-variable 'mastodon-tl--enable-relative-timestamps) @@ -238,7 +242,8 @@ ENPOINT is the endpoint for the stream and timeline." (defun mastodon-async--start-process (endpoint filter &optional name) "Start an async mastodon stream at ENDPOINT. -Filter the toots using FILTER." +Filter the toots using FILTER. +NAME is used for the queue and display buffer." (let* ((stream (concat "streaming/" endpoint)) (async-queue (mastodon-async--setup-queue "" (or name stream))) (async-buffer (mastodon-async--setup-buffer "" (or name stream) endpoint)) @@ -249,7 +254,7 @@ Filter the toots using FILTER." (message "HTTP SOURCE CLOSED"))))) (mastodon-async--setup-http http-buffer (or name stream)) (mastodon-async--set-http-buffer async-buffer http-buffer) - (mastodon-async--set-http-buffer async-queue http-buffer) + (mastodon-async--set-http-buffer async-queue http-buffer) (set-process-filter (get-buffer-process http-buffer) (mastodon-async--http-hook filter)) http-buffer)) diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 8355200..31df2ae 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index cb8eb26..a03d035 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 6b2eadf..21a0f95 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 00a0718..4461ea2 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "27.1") (request "0.2.0")) +;; Package-Requires: ((emacs "27.1") (request "0.3.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index 4d91948..c9a9277 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. @@ -98,6 +98,7 @@ (defvar mastodon-inspect--search-result-tags) (defun mastodon-inspect--get-search-result (query) + "Inspect function for a search result for QUERY." (interactive) (setq mastodon-inspect--search-query-full-result (append ; convert vector to list @@ -111,6 +112,7 @@ nil))) (defun mastodon-inspect--get-search-account (query) + "Return JSON for a single account after search QUERY." (interactive) (setq mastodon-inspect--search-query-accounts-result (append ; convert vector to list diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index bbab816..6e02ebb 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 5efb7d4..ebf98ba 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index d21f5c0..dbe5686 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1") (seq "1.0")) +;; Package-Requires: ((emacs "27.1") (seq "1.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index a7dcda9..6317895 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen , martyhiatt ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 89604b5..71e08de 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index c89acc7..6cf337a 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. @@ -545,7 +545,11 @@ The prefix can match against both user handles and display names." (propertize handle 'annot display-name 'meta url))) (defun mastodon-toot-mentions (command &optional arg &rest ignored) - "A company completion backend for toot mentions." + "A company completion backend for toot mentions. +COMMAND is either prefix, to fetch a prefix query, candidates, to +build a list of candidates with query ARG, annotation, to format +an annotation for candidate ARG, or meta, to format meta info for +candidate ARG. IGNORED remains a mystery." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'mastodon-toot-mentions)) @@ -645,7 +649,7 @@ File is actually attached to the toot upon posting." (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments))))) (defun mastodon-toot--upload-attached-media (attachment) - "Upload a single attachment using `mastodon-http--post-media-attachment'. + "Upload a single ATTACHMENT using `mastodon-http--post-media-attachment'. The item's id is added to `mastodon-toot--media-attachment-ids', which is used to attach it to a toot when posting." (let* ((filename (expand-file-name diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 2411e20..adc1ac8 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Version: 0.9.2 -;; Package-Requires: ((emacs "26.1") (request "0.3.2") (seq "1.0")) +;; Package-Requires: ((emacs "27.1") (request "0.3.2") (seq "1.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. @@ -31,7 +31,8 @@ ;;; Code: (require 'cl-lib) ; for `cl-some' call in mastodon -(require 'mastodon-toot) ; hack to make mastodon-toot customs visible +;; hack to make mastodon-toot customizes visible prior to running mastodon-toot: +(require 'mastodon-toot) (declare-function discover-add-context-menu "discover") (declare-function emojify-mode "emojify") -- cgit v1.2.3 From 242628c090adad5e6f6292b108c6626bd78bf11a Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 18:06:41 +0100 Subject: boilerplate maintainer contact --- lisp/mastodon-async.el | 2 ++ lisp/mastodon-auth.el | 1 + lisp/mastodon-client.el | 1 + lisp/mastodon-discover.el | 1 + lisp/mastodon-http.el | 1 + lisp/mastodon-inspect.el | 1 + lisp/mastodon-media.el | 1 + lisp/mastodon-notifications.el | 1 + lisp/mastodon-profile.el | 1 + lisp/mastodon-search.el | 4 +++- lisp/mastodon-tl.el | 1 + lisp/mastodon-toot.el | 1 + lisp/mastodon.el | 1 + 13 files changed, 16 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 77fdb8e..bda6a4d 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -2,6 +2,8 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen +;; Alex J. Griffith +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 31df2ae..0b9a0dd 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index a03d035..2ecfff4 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index 21a0f95..c8e3fd0 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 4461ea2..0447e22 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1") (request "0.3.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index c9a9277..209e8dd 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 6e02ebb..5e2699a 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ebf98ba..ac0d339 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index dbe5686..0ed4d04 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1") (seq "1.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 6317895..04b3e23 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -1,7 +1,9 @@ ;;; mastodon-search.el --- Search functions for mastodon.el -*- lexical-binding: t -*- ;; Copyright (C) 2017-2019 Johnson Denen -;; Author: Johnson Denen , martyhiatt +;; Author: Johnson Denen +;; Marty Hiatt +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 71e08de..45b905d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 6cf337a..5b46f5e 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon.el b/lisp/mastodon.el index adc1ac8..9a0fe37 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -2,6 +2,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen +;; Maintainer: Marty Hiatt ;; Version: 0.9.2 ;; Package-Requires: ((emacs "27.1") (request "0.3.2") (seq "1.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el -- cgit v1.2.3 From c1aa61bb361cca5d107896a83b1b729315c4d79a Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 18:18:28 +0100 Subject: bump version to a round number --- lisp/mastodon-async.el | 2 +- lisp/mastodon-auth.el | 2 +- lisp/mastodon-client.el | 2 +- lisp/mastodon-discover.el | 2 +- lisp/mastodon-http.el | 2 +- lisp/mastodon-inspect.el | 2 +- lisp/mastodon-media.el | 2 +- lisp/mastodon-notifications.el | 2 +- lisp/mastodon-profile.el | 2 +- lisp/mastodon-search.el | 2 +- lisp/mastodon-tl.el | 2 +- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 2 +- 13 files changed, 13 insertions(+), 13 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index bda6a4d..6ff09e3 100644 --- a/lisp/mastodon-async.el +++ b/lisp/mastodon-async.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Alex J. Griffith ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index 0b9a0dd..e4f5934 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index 2ecfff4..b27d434 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index c8e3fd0..10abc59 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 0447e22..33182ff 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1") (request "0.3.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index 209e8dd..b0270ee 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index 5e2699a..acce473 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index ac0d339..6d48681 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 0ed4d04..e8025ed 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1") (seq "1.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-search.el b/lisp/mastodon-search.el index 04b3e23..78c2ab4 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -4,7 +4,7 @@ ;; Author: Johnson Denen ;; Marty Hiatt ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 67cdf82..62550cd 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 5b46f5e..e813b33 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 9a0fe37..d5f9b6e 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen ;; Maintainer: Marty Hiatt -;; Version: 0.9.2 +;; Version: 0.10.0 ;; Package-Requires: ((emacs "27.1") (request "0.3.2") (seq "1.0")) ;; Homepage: https://git.blast.noho.st/mouse/mastodon.el -- cgit v1.2.3 From 9f5b56b4003f4ff5b2c3e6183de228d22c94574c Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 19:18:46 +0100 Subject: y-or-n-p before cancelling a toot. --- lisp/mastodon-toot.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index e813b33..230f7d2 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -359,7 +359,13 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (defun mastodon-toot--cancel () "Kill new-toot buffer/window. Does not POST content to Mastodon." (interactive) - (mastodon-toot--kill)) + (let* ((toot (mastodon-toot--remove-docs)) + (empty-toot-p (and (not mastodon-toot--media-attachments) + (string= "" (mastodon-tl--clean-tabs-and-nl toot))))) + (if empty-toot-p + (mastodon-toot--kill) + (when (y-or-n-p "Discard draft toot? ") + (mastodon-toot--kill))))) (defalias 'mastodon-toot--insert-emoji 'emojify-insert-emoji -- cgit v1.2.3 From 5c894196298f8f5dfdddefeccb1e4694c0fc1a6f Mon Sep 17 00:00:00 2001 From: mousebot Date: Fri, 17 Dec 2021 22:43:48 +0100 Subject: autoload typo --- lisp/mastodon-toot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 230f7d2..31613d0 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -50,7 +50,7 @@ (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") -(autoload 'mastodon-http--get-json-async "mastodon-htpp") +(autoload 'mastodon-http--get-json-async "mastodon-http") (autoload 'mastodon-http--post "mastodon-http") (autoload 'mastodon-http--post-media-attachment "mastodon-http") (autoload 'mastodon-http--process-json "mastodon-http") -- cgit v1.2.3 From 4cec0aa24f717489be5d1959682d0c14b349d5af Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 20 Dec 2021 19:29:34 +0100 Subject: refactoring delete/redraft functions --- lisp/mastodon-toot.el | 80 +++++++++++++++++++++++++++------------------------ 1 file changed, 43 insertions(+), 37 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 31613d0..f49b35c 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -46,6 +46,7 @@ (defvar company-backends)) (defvar mastodon-instance-url) +(defvar mastodon-tl--buffer-spec) (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") @@ -277,27 +278,21 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (kill-new url) (message "Toot URL copied to the clipboard."))) +(defun mastodon-toot--own-toot-p (toot) + "Check if TOOT is user's own, e.g. for deleting it." + (and (not (alist-get 'reblog toot)) + (equal (alist-get 'acct (alist-get 'account toot)) + (mastodon-auth--user-acct)))) + (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s" id)))) - (if (or (alist-get 'reblog toot) - (not (equal (alist-get 'acct - (alist-get 'account toot)) - (mastodon-auth--user-acct)))) - (message "You can only delete your own toots.") - (if (y-or-n-p (format "Delete this toot? ")) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda () - (mastodon-tl--reload-timeline-or-profile) - (message "Toot deleted!")))))))) + (mastodon-toot--delete-and-redraft-toot t)) ;; TODO: handle media/poll for redrafting toots -(defun mastodon-toot--delete-and-redraft-toot () - "Delete and redraft user's toot at point synchronously." +(defun mastodon-toot--delete-and-redraft-toot (&optional no-redraft) + "Delete and redraft user's toot at point synchronously. +NO-REDRAFT means delete toot only." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) @@ -305,31 +300,42 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (toot-cw (alist-get 'spoiler_text toot)) (toot-visibility (alist-get 'visibility toot)) (reply-id (alist-get 'in_reply_to_id toot))) - (if (or (alist-get 'reblog toot) - (not (equal (alist-get 'acct - (alist-get 'account toot)) - (mastodon-auth--user-acct)))) - (message "You can only delete and redraft your own toots.") - (if (y-or-n-p (format "Delete and redraft this toot? ")) + (if (not (mastodon-toot--own-toot-p toot)) + (message "You can only delete (and redraft) your own toots.") + (if (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) (let* ((response (mastodon-http--delete url))) (mastodon-http--triage response (lambda () - (with-current-buffer response - (let* ((json-response (mastodon-http--process-json)) - (content (alist-get 'text json-response))) - ;; (media (alist-get 'media_attachments json-response))) - (mastodon-toot--compose-buffer nil nil) - (goto-char (point-max)) - (insert content) - ;; adopt reply-to-id, visibility and CW from deleted toot: - (when reply-id - (setq mastodon-toot--reply-to-id reply-id)) - (setq mastodon-toot--visibility toot-visibility) - (when (not (equal toot-cw "")) - (setq mastodon-toot--content-warning t) - (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) - (mastodon-toot--update-status-fields)))))))))) + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + reply-id + toot-visibility + toot-cw))))))))) + +(defun mastodon-toot--redraft (response &optional reply-id toot-visibility toot-cw) + "Opens a new toot compose buffer using values from RESPONSE buffer. +REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." + (with-current-buffer response + (let* ((json-response (mastodon-http--process-json)) + (content (alist-get 'text json-response))) + (mastodon-toot--compose-buffer nil nil) + (goto-char (point-max)) + (insert content) + ;; adopt reply-to-id, visibility and CW from deleted toot: + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) + (setq mastodon-toot--visibility toot-visibility) + (when (not (equal toot-cw "")) + (setq mastodon-toot--content-warning t) + (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) + (mastodon-toot--update-status-fields)))) (defun mastodon-toot--bookmark-toot-toggle () "Bookmark or unbookmark toot at point synchronously." -- cgit v1.2.3 From 7d93e1f38332d03de0d935c7460bf3eb2821bf7d Mon Sep 17 00:00:00 2001 From: mousebot Date: Mon, 20 Dec 2021 22:31:11 +0100 Subject: docstring and move pin toot toggle --- lisp/mastodon-toot.el | 39 ++++++++++++++++++--------------------- 1 file changed, 18 insertions(+), 21 deletions(-) (limited to 'lisp/mastodon-toot.el') diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index f49b35c..ec1ba49 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -188,7 +188,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (propertize marker 'face 'success))))))) (defun mastodon-toot--action (action callback) - "Take ACTION on toot at point, then execute CALLBACK." + "Take ACTION on toot at point, then execute CALLBACK. +Makes a POST request to the server." (let* ((id (mastodon-tl--property 'base-toot-id)) (url (mastodon-http--api (concat "statuses/" (mastodon-tl--as-string id) @@ -248,26 +249,6 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (message (format "%s #%s" action id)))) (message "Nothing to favorite here?!?")))) -(defun mastodon-toot--pin-toot-toggle () - "Pin or unpin user's toot at point." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (pinnable-p (and - (not (alist-get 'reblog toot)) - (equal (alist-get 'acct - (alist-get 'account toot)) - (mastodon-auth--user-acct)))) - (pinned-p (equal (alist-get 'pinned toot) t)) - (action (if pinned-p "unpin" "pin")) - (msg (if pinned-p "unpinned" "pinned")) - (msg-y-or-n (if pinned-p "Unpin" "Pin"))) - (if (not pinnable-p) - (message "You can only pin your own toots.") - (if (y-or-n-p (format "%s this toot? " msg-y-or-n)) - (mastodon-toot--action action - (lambda () - (message "Toot %s!" msg))))))) - (defun mastodon-toot--copy-toot-url () "Copy URL of toot at point." (interactive) @@ -284,6 +265,22 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (equal (alist-get 'acct (alist-get 'account toot)) (mastodon-auth--user-acct)))) +(defun mastodon-toot--pin-toot-toggle () + "Pin or unpin user's toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (pinnable-p (mastodon-toot--own-toot-p toot)) + (pinned-p (equal (alist-get 'pinned toot) t)) + (action (if pinned-p "unpin" "pin")) + (msg (if pinned-p "unpinned" "pinned")) + (msg-y-or-n (if pinned-p "Unpin" "Pin"))) + (if (not pinnable-p) + (message "You can only pin your own toots.") + (if (y-or-n-p (format "%s this toot? " msg-y-or-n)) + (mastodon-toot--action action + (lambda () + (message "Toot %s!" msg))))))) + (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." (interactive) -- cgit v1.2.3