diff options
| -rw-r--r-- | lisp/mastodon-async.el | 40 | ||||
| -rw-r--r-- | lisp/mastodon-auth.el | 11 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 133 | ||||
| -rw-r--r-- | lisp/mastodon-inspect.el | 5 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 4 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 82 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 98 | ||||
| -rw-r--r-- | lisp/mastodon-search.el | 104 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 148 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 227 | ||||
| -rw-r--r-- | lisp/mastodon.el | 4 | ||||
| -rw-r--r-- | test/mastodon-auth-tests.el | 14 | ||||
| -rw-r--r-- | test/mastodon-client-tests.el | 64 | ||||
| -rw-r--r-- | test/mastodon-http-tests.el | 6 | ||||
| -rw-r--r-- | test/mastodon-media-tests.el | 266 | ||||
| -rw-r--r-- | test/mastodon-notifications-test.el | 4 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 420 | ||||
| -rw-r--r-- | test/mastodon-toot-tests.el | 6 |
18 files changed, 800 insertions, 836 deletions
diff --git a/lisp/mastodon-async.el b/lisp/mastodon-async.el index 56dc230..524e13d 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." @@ -180,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 @@ -206,11 +203,12 @@ 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" - (endpoint (if (equal name "notifications") "notifications" - (if (equal name "home") "timelines/home" - (format "timelines/%s" endpoint))))) + ;; if user stream, we need "timelines/home" not "timelines/user" + ;; if notifs, we need "notifications" not "timelines/notifications" + (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. @@ -288,8 +286,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) @@ -307,8 +305,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))))))) + "@" + (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..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) @@ -158,11 +157,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 875e9bf..1ec0dc0 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -67,15 +67,15 @@ (string-match "[0-9][0-9][0-9]" status-line) (match-string 0 status-line))) -;; (defun mastodon-http--triage (response success) -;; "Determine if RESPONSE was successful. Call SUCCESS if successful. +(defun mastodon-http--url-retrieve-synchronously (url) + "Retrieve URL asynchronously. -;; Open RESPONSE buffer if unsuccessful." -;; (let ((status (with-current-buffer response -;; (mastodon-http--status)))) -;; (if (string-prefix-p "2" status) -;; (funcall success) -;; (switch-to-buffer response)))) +This is a thin abstraction over the system +`url-retrieve-synchronously`. Depending on which version of this +is available we will call it with or without a timeout." + (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) + (url-retrieve-synchronously url) + (url-retrieve-synchronously url nil nil mastodon-http--timeout))) (defun mastodon-http--triage (response success) "Determine if RESPONSE was successful. Call SUCCESS if successful. @@ -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 (cdr (assoc '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." @@ -115,9 +114,7 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token))))) 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))))) + (mastodon-http--url-retrieve-synchronously url)))) (defun mastodon-http--get (url) "Make synchronous GET request to URL. @@ -129,16 +126,6 @@ Pass response buffer to CALLBACK function." (mastodon-auth--access-token)))))) (mastodon-http--url-retrieve-synchronously url))) -(defun mastodon-http--url-retrieve-synchronously (url) - "Retrieve URL asynchronously. - -This is a thin abstraction over the system -`url-retrieve-synchronously`. Depending on which version of this -is available we will call it with or without a timeout." - (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) - (url-retrieve-synchronously url) - (url-retrieve-synchronously url nil nil mastodon-http--timeout))) - (defun mastodon-http--get-json (url) "Make synchronous GET request to URL. Return JSON response." (with-current-buffer (mastodon-http--get url) @@ -153,8 +140,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." @@ -163,7 +150,7 @@ is available we will call it with or without a timeout." `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))) (with-temp-buffer - (url-retrieve-synchronously url)))) + (mastodon-http--url-retrieve-synchronously url)))) ;; search functions: (defun mastodon-http--process-json-search () @@ -195,9 +182,7 @@ PARAM is a formatted request parameter, eg 'following=true'." (url-request-extra-headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))) - (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) - (url-retrieve-synchronously url) - (url-retrieve-synchronously url nil nil mastodon-http--timeout)))) + (mastodon-http--url-retrieve-synchronously url))) ;; profile update functions @@ -218,9 +203,7 @@ Pass response buffer to CALLBACK function." (url-request-extra-headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))) - (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) - (url-retrieve-synchronously url) - (url-retrieve-synchronously url nil nil mastodon-http--timeout)))) + (mastodon-http--url-retrieve-synchronously url))) ;; Asynchronous functions @@ -256,8 +239,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 +252,44 @@ 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 + (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 + ;; 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..57240f3 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -30,12 +30,15 @@ ;;; Code: (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--get-json "mastodon-http") +(autoload 'mastodon-http--get-search-json "mastodon-http") (autoload 'mastodon-media--inline-images "mastodon-media") (autoload 'mastodon-mode "mastodon") (autoload 'mastodon-tl--as-string "mastodon-tl") (autoload 'mastodon-tl--property "mastodon-tl") (autoload 'mastodon-tl--toot "mastodon-tl") +(defvar mastodon-instance-url) + (defgroup mastodon-inspect nil "Tools to help inspect toots." :prefix "mastodon-inspect-" @@ -59,7 +62,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..4437635 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -78,25 +78,25 @@ (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)))) - (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 (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 + (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 () @@ -104,30 +104,30 @@ (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)))) - (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 (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 + (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) "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 018af21..81ab837 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 @@ -164,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 @@ -186,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 @@ -210,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) @@ -248,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) @@ -257,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,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))) @@ -328,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) @@ -350,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 @@ -383,7 +381,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 @@ -397,11 +395,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)))) @@ -444,12 +442,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))) @@ -462,7 +460,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)) @@ -478,35 +476,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 5f52bb7..fcfaec9 100644 --- a/lisp/mastodon-search.el +++ b/lisp/mastodon-search.el @@ -72,15 +72,15 @@ 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 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,66 +97,66 @@ 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." - (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. + "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. @@ -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 b1b7c68..62d283b 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." @@ -92,27 +91,24 @@ 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 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))) @@ -270,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 @@ -302,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 " @@ -314,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. @@ -467,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))))) @@ -506,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)) @@ -656,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 @@ -675,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 @@ -694,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)) @@ -722,22 +718,18 @@ 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))) + ;; prefer the reblog toot if present: + (let ((toot-to-use (or (alist-get 'reblog toot) toot))) (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot) - (alist-get 'reblogs_count toot) - (alist-get 'replies_count toot)))) + (alist-get 'favourites_count toot-to-use) + (alist-get 'reblogs_count toot-to-use) + (alist-get 'replies_count toot-to-use)))) 'toot-json toot) "\n") (when mastodon-tl--display-media-p @@ -751,10 +743,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)) + (alist-get 'title option) + (alist-get 'votes_count option)))) options "\n") "\n"))) @@ -763,13 +755,13 @@ 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))) - options)) + (alist-get 'title x)) + options)) (options-number-seq (number-sequence 1 (length options))) (options-numbers (mapcar (lambda(x) (number-to-string x)) @@ -779,22 +771,22 @@ 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.") (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))))) @@ -920,9 +912,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 () @@ -934,10 +926,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) @@ -949,9 +941,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) @@ -965,7 +957,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)))) @@ -987,7 +979,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)))) @@ -1010,7 +1002,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)))) @@ -1029,8 +1021,8 @@ 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))) - mutes-json))) + (alist-get 'acct muted)) + mutes-json))) (completing-read "Handle of user to unmute: " muted-accts nil ; predicate @@ -1059,7 +1051,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)))) @@ -1078,7 +1070,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 deea2ef..885db1d 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.") @@ -162,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))) @@ -191,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)))) @@ -253,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"))) @@ -273,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."))) @@ -284,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? ")) @@ -303,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? ")) @@ -318,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) @@ -337,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)))) @@ -345,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 @@ -373,26 +366,27 @@ 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) - (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. @@ -503,12 +497,12 @@ 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 + (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)) ""))) @@ -541,19 +535,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'." @@ -561,12 +555,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 @@ -641,8 +635,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))) @@ -666,14 +660,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 @@ -714,9 +708,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. @@ -795,8 +788,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) @@ -811,38 +804,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))) |