diff options
| -rw-r--r-- | lisp/mastodon-http.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-media.el | 34 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 26 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 4 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 256 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 72 | ||||
| -rw-r--r-- | lisp/mastodon.el | 6 | ||||
| l--------- | test/fixture | 1 | ||||
| -rw-r--r-- | test/mastodon-auth-test.el | 47 | ||||
| -rw-r--r-- | test/mastodon-auth-tests.el | 133 | ||||
| -rw-r--r-- | test/mastodon-client-tests.el | 102 | ||||
| -rw-r--r-- | test/mastodon-http-tests.el | 13 | ||||
| -rw-r--r-- | test/mastodon-media-tests.el | 375 | ||||
| -rw-r--r-- | test/mastodon-notifications-test.el | 22 | ||||
| -rw-r--r-- | test/mastodon-search-tests.el | 106 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 445 | ||||
| -rw-r--r-- | test/mastodon-toot-tests.el | 31 |
17 files changed, 890 insertions, 785 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 1ec0dc0..a4f126f 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -261,7 +261,7 @@ item uploaded, and `mastodon-toot--update-status-fields' is run." :parser 'json-read :headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) - :sync t + :sync nil :success (cl-function (lambda (&key data &allow-other-keys) (when data diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index f7386c6..457628f 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -292,21 +292,27 @@ Replace them with the referenced image." t image-options)) " "))) -(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url) +(defun mastodon-media--get-media-link-rendering (media-url &optional full-remote-url type) "Return the string to be written that renders the image at MEDIA-URL. -FULL-REMOTE-URL is used for `shr-browse-image'." - (concat - (propertize "[img]" - 'media-url media-url - 'media-state 'needs-loading - 'media-type 'media-link - 'display (create-image mastodon-media--generic-broken-image-data nil t) - 'mouse-face 'highlight - 'mastodon-tab-stop 'image ; for do-link-action-at-point - 'image-url full-remote-url ; for shr-browse-image - 'keymap mastodon-tl--shr-image-map-replacement - 'help-echo (concat "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) - " ")) +FULL-REMOTE-URL is used for `shr-browse-image'. +TYPE is the attachment's type field on the server." + (let ((help-echo + "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview")) + (concat + (propertize "[img]" + 'media-url media-url + 'media-state 'needs-loading + 'media-type 'media-link + 'mastodon-media-type type + 'display (create-image mastodon-media--generic-broken-image-data nil t) + 'mouse-face 'highlight + 'mastodon-tab-stop 'image ; for do-link-action-at-point + 'image-url full-remote-url ; for shr-browse-image + 'keymap mastodon-tl--shr-image-map-replacement + 'help-echo (if (string= type "image") + help-echo + (concat help-echo "\ntype: " type))) + " "))) (provide 'mastodon-media) ;;; mastodon-media.el ends here diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index 4437635..15633be 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -54,7 +54,8 @@ ("follow" . mastodon-notifications--follow) ("favourite" . mastodon-notifications--favourite) ("reblog" . mastodon-notifications--reblog) - ("follow_request" . mastodon-notifications--follow-request)) + ("follow_request" . mastodon-notifications--follow-request) + ("status" . mastodon-notifications--status)) "Alist of notification types and their corresponding function.") (defvar mastodon-notifications--response-alist @@ -62,7 +63,8 @@ ("Followed" . "you") ("Favourited" . "your status from") ("Boosted" . "your status from") - ("Requested to follow" . "you")) + ("Requested to follow" . "you") + ("Posted" . "a post")) "Alist of subjects for notification types.") (defun mastodon-notifications--byline-concat (message) @@ -204,6 +206,26 @@ "Boosted")) id))) +(defun mastodon-notifications--status (note) + "Format for a `status' NOTE. +Status notifications are given when +`mastodon-tl--notify-user-posts' has been set." + (let ((id (cdr (assoc 'id note))) + (status (mastodon-tl--field 'status note))) + (mastodon-notifications--insert-status + status + (mastodon-tl--clean-tabs-and-nl + (if (mastodon-tl--has-spoiler status) + (mastodon-tl--spoiler status) + (mastodon-tl--content status))) + (lambda (_status) + (mastodon-tl--byline-author + note)) + (lambda (_status) + (mastodon-notifications--byline-concat + "Posted")) + id))) + (defun mastodon-notifications--insert-status (toot body author-byline action-byline &optional id) "Display the content and byline of timeline element TOOT. diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 81ab837..7a9edc3 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -68,8 +68,8 @@ ;; this way you can update it with C-M-x: (defvar mastodon-profile-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "O") #'mastodon-profile--open-followers) - (define-key map (kbd "o") #'mastodon-profile--open-following) + (define-key map (kbd "s") #'mastodon-profile--open-followers) + (define-key map (kbd "g") #'mastodon-profile--open-following) (define-key map (kbd "a") #'mastodon-profile--follow-request-accept) (define-key map (kbd "j") #'mastodon-profile--follow-request-reject) map) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 112b59f..1cb9863 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -287,13 +287,13 @@ Optionally start from POS." (propertize (concat "@" handle) 'face 'mastodon-handle-face 'mouse-face 'highlight - ;; TODO: Replace url browsing with native profile viewing - 'mastodon-tab-stop 'user-handle + ;; TODO: Replace url browsing with native profile viewing + 'mastodon-tab-stop 'user-handle 'account account - 'shr-url profile-url - 'keymap mastodon-tl--link-keymap + 'shr-url profile-url + 'keymap mastodon-tl--link-keymap 'mastodon-handle (concat "@" handle) - 'help-echo (concat "Browse user profile of @" handle)) + 'help-echo (concat "Browse user profile of @" handle)) ")"))) (defun mastodon-tl--byline-boosted (toot) @@ -676,10 +676,11 @@ message is a link which unhides/hides the main body." (if (alist-get 'remote_url media-attachement) (alist-get 'remote_url media-attachement) ;; fallback b/c notifications don't have remote_url - (alist-get 'url media-attachement)))) + (alist-get 'url media-attachement))) + (type (alist-get 'type media-attachement))) (if mastodon-tl--display-media-p (mastodon-media--get-media-link-rendering - preview-url remote-url) ; 2nd arg for shr-browse-url + preview-url remote-url type) ; 2nd arg for shr-browse-url (concat "Media::" preview-url "\n")))) media-attachements ""))) (if (not (and mastodon-tl--display-media-p @@ -695,9 +696,9 @@ message is a link which unhides/hides the main body." (alist-get 'poll reblog) (alist-get 'poll toot)))) (concat + (mastodon-tl--render-text content toot) (when poll-p (mastodon-tl--get-poll toot)) - (mastodon-tl--render-text content toot) (mastodon-tl--media toot)))) (defun mastodon-tl--insert-status (toot body author-byline action-byline) @@ -740,16 +741,30 @@ takes a single function. By default it is "If post TOOT is a poll, return a formatted string of poll." (let* ((poll (mastodon-tl--field 'poll toot)) (options (mastodon-tl--field 'options poll)) + (option-titles (mapcar (lambda (x) + (alist-get 'title x)) + options)) + (longest-option (car (sort option-titles + (lambda (x y) + (> (length x) + (length y)))))) (option-counter 0)) - (concat "Poll: \n\n" + (concat "\nPoll: \n\n" (mapconcat (lambda (option) (progn - (format "Option %s: %s, %s votes.\n" + (format "Option %s: %s%s [%s votes].\n" (setq option-counter (1+ option-counter)) (alist-get 'title option) + (make-string + (1+ + (- (length longest-option) + (length (alist-get 'title + option)))) + ?\ ) (alist-get 'votes_count option)))) options - "\n") "\n"))) + "\n") + "\n"))) (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." @@ -947,149 +962,138 @@ webapp" (alist-get 'descendants context))))) (message "No Thread!")))) -(defun mastodon-tl--follow-user (user-handle) - "Query for USER-HANDLE from current status and follow that user." +(defun mastodon-tl--follow-user (user-handle &optional notify) + "Query for USER-HANDLE from current status and follow that user. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts. +This can be called to toggle NOTIFY on users already being followed." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to follow: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - 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)))) - (if account - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) followed!" name user-handle)))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "follow"))) + (mastodon-tl--do-user-action-and-response user-handle "follow" nil notify)) -(defun mastodon-tl--unfollow-user (user-handle) - "Query for USER-HANDLE from current status and unfollow that user." +(defun mastodon-tl--enable-notify-user-posts (user-handle) + "Query for USER-HANDLE and enable notifications when they post." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to unfollow: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - 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)))) - (if account - (when (y-or-n-p (format "Unfollow user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) unfollowed!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "enable"))) + (mastodon-tl--follow-user user-handle "true")) -(defun mastodon-tl--mute-user (user-handle) - "Query for USER-HANDLE from current status and mute that user." +(defun mastodon-tl--disable-notify-user-posts (user-handle) + "Query for USER-HANDLE and disable notifications when they post." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to mute: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - 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)))) - (if account - (when (y-or-n-p (format "Mute user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) muted!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "disable"))) + (mastodon-tl--follow-user user-handle "false")) -(defun mastodon-tl--unmute-user (user-handle) - "Query for USER-HANDLE from list of muted users and unmute that user." +(defun mastodon-tl--unfollow-user (user-handle) + "Query for USER-HANDLE from current status and unfollow that user." (interactive (list - (let* ((mutes-url (mastodon-http--api (format "mutes"))) - (mutes-json (mastodon-http--get-json mutes-url)) - (muted-accts (mapcar (lambda (muted) - (alist-get 'acct muted)) - mutes-json))) - (completing-read "Handle of user to unmute: " - muted-accts - nil ; predicate - t)))) - (let* ((account (mastodon-profile--search-account-by-handle - user-handle)) - (user-id (mastodon-profile--account-field account 'id)) - (name (mastodon-profile--account-field account 'display_name)) - (url (mastodon-http--api (format "accounts/%s/unmute" user-id)))) - (if account - (when (y-or-n-p (format "Unmute user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) unmuted!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "unfollow"))) + (mastodon-tl--do-user-action-and-response user-handle "unfollow" t)) (defun mastodon-tl--block-user (user-handle) "Query for USER-HANDLE from current status and block that user." (interactive (list - (let ((user-handles (mastodon-profile--extract-users-handles - (mastodon-profile--toot-json)))) - (completing-read "Handle of user to block: " - user-handles - nil ; predicate - 'confirm)))) - (let* ((account (mastodon-profile--lookup-account-in-status - 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)))) - (if account - (when (y-or-n-p (format "Block user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) blocked!" name user-handle))))) - (message "Cannot find a user with handle %S" user-handle)))) + (mastodon-tl--interactive-user-handles-get "block"))) + (mastodon-tl--do-user-action-and-response user-handle "block")) (defun mastodon-tl--unblock-user (user-handle) "Query for USER-HANDLE from list of blocked users and unblock that user." (interactive (list - (let* ((blocks-url (mastodon-http--api (format "blocks"))) - (blocks-json (mastodon-http--get-json blocks-url)) - (blocked-accts (mapcar (lambda (blocked) - (alist-get 'acct blocked)) - blocks-json))) - (completing-read "Handle of user to unblock: " - blocked-accts + (mastodon-tl--interactive-blocks-or-mutes-list-get "unblock"))) + (if (not user-handle) + (message "Looks like you have no blocks to unblock!") + (mastodon-tl--do-user-action-and-response user-handle "unblock" t))) + +(defun mastodon-tl--mute-user (user-handle) + "Query for USER-HANDLE from current status and mute that user." + (interactive + (list + (mastodon-tl--interactive-user-handles-get "mute"))) + (mastodon-tl--do-user-action-and-response user-handle "mute")) + +(defun mastodon-tl--unmute-user (user-handle) + "Query for USER-HANDLE from list of muted users and unmute that user." + (interactive + (list + (mastodon-tl--interactive-blocks-or-mutes-list-get "unmute"))) + (if (not user-handle) + (message "Looks like you have no mutes to unmute!") + (mastodon-tl--do-user-action-and-response user-handle "unmute" t))) + +(defun mastodon-tl--interactive-user-handles-get (action) + "Get the list of user-handles for ACTION from the current toot." + (let ((user-handles (mastodon-profile--extract-users-handles + (mastodon-profile--toot-json)))) + (completing-read (if (or (equal action "disable") + (equal action "enable")) + (format "%s notifications when user posts: " action) + (format "Handle of user to %s: " action)) + user-handles + nil ; predicate + 'confirm))) + +(defun mastodon-tl--interactive-blocks-or-mutes-list-get (action) + "Fetch the list of accounts for ACTION from the server. +Action must be either \"unblock\" or \"mute\"." + (let* ((endpoint (cond ((equal action "unblock") + "blocks") + ((equal action "unmute") + "mutes"))) + (url (mastodon-http--api endpoint)) + (json (mastodon-http--get-json url)) + (accts (mapcar (lambda (user) + (alist-get 'acct user)) + json))) + (when accts + (completing-read (format "Handle of user to %s: " action) + accts nil ; predicate t)))) - (let* ((account (mastodon-profile--search-account-by-handle - user-handle)) + +(defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify) + "Do ACTION on user NAME/USER-HANDLE. +NEGP is whether the action involves un-doing something. +If NOTIFY is \"true\", enable notifications when that user posts. +If NOTIFY is \"false\", disable notifications when that user posts. +NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." + (let* ((account (if negp + ;; TODO check if both are actually needed + (mastodon-profile--search-account-by-handle + user-handle) + (mastodon-profile--lookup-account-in-status + 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/unblock" user-id)))) + (url (mastodon-http--api + (if notify + (format "accounts/%s/%s?notify=%s" user-id action notify) + (format "accounts/%s/%s" user-id action))))) (if account - (when (y-or-n-p (format "Unblock user %s? " name)) - (let ((response (mastodon-http--post url nil nil))) - (mastodon-http--triage response - (lambda () - (message "User %s (@%s) unblocked!" name user-handle))))) + (if (equal action "follow") ; y-or-n for all but follow + (mastodon-tl--do-user-action-function url name user-handle action notify) + (when (y-or-n-p (format "%s user %s? " action name)) + (mastodon-tl--do-user-action-function url name user-handle action))) (message "Cannot find a user with handle %S" user-handle)))) +(defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify) + "Post ACTION on user NAME/USER-HANDLE to URL." + (let ((response (mastodon-http--post url nil nil))) + (mastodon-http--triage response + (lambda () + (cond ((string-equal notify "true") + (message "Receiving notifications for user %s (@%s)!" + name user-handle)) + ((string-equal notify "false") + (message "Not receiving notifications for user %s (@%s)!" + name user-handle)) + ((eq notify nil) + (message "User %s (@%s) %sed!" name user-handle action))))))) + ;; TODO: add this to new posts in some cases, e.g. in thread view. (defun mastodon-tl--reload-timeline-or-profile () "Reload the current timeline or profile page. diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 885db1d..8d2df60 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -106,6 +106,11 @@ This is only used if company mode is installed." (const :tag "following only" "following") (const :tag "all users" "all"))) +(defcustom mastodon-toot--enable-custom-instance-emoji nil + "Whether to enable your instance's custom emoji by default." + :group 'mastodon-toot + :type 'boolean) + (defvar-local mastodon-toot--content-warning nil "A flag whether the toot should be marked with a content warning.") @@ -446,10 +451,8 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--send () "POST contents of new-toot buffer to Mastodon instance and kill buffer. -If media items have been attached with -`mastodon-toot--attach-media', upload them with -`mastodon-toot-upload-attached-media' and attach them to the -toot." +If media items have been attached and uploaded with +`mastodon-toot--attach-media', they are attached to the toot." (interactive) (let* ((toot (mastodon-toot--remove-docs)) (empty-toot-p (and (not mastodon-toot--media-attachments) @@ -465,10 +468,14 @@ toot." (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mastodon-toot--upload-attached-media) ; sync upload so we wait (and pray) till done - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (if (= (length mastodon-toot--media-attachments) + (length mastodon-toot--media-attachment-ids)) + ;; (mastodon-toot--upload-attached-media) + ;; moved upload to mastodon-toot--attach-media + (mapcar (lambda (id) + (cons "media_ids[]" id)) + mastodon-toot--media-attachment-ids) + (message "Looks like something went wrong with your uploads. Maybe you want to try again.")))) (args (append args-media args-no-media))) (if (> (length toot) (string-to-number mastodon-toot--max-toot-chars)) (message "Looks like your toot is longer than that maximum allowed length.") @@ -519,10 +526,11 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"." (defun mastodon-toot--mentions-company-candidates (prefix) "Given a company PREFIX query, build a list of candidates. The prefix can match against both user handles and display names." - (let (res) + (let ((prefix (substring prefix 1)) ;remove @ for search + (res)) (dolist (item (mastodon-search--search-accounts-query prefix)) - (when (or (string-prefix-p prefix (cadr item)) - (string-prefix-p prefix (car item))) + (when (or (string-prefix-p prefix (substring (cadr item) 1) t) + (string-prefix-p prefix (car item) t)) (push (mastodon-toot--mentions-company-make-candidate item) res))) res)) @@ -533,11 +541,11 @@ The prefix can match against both user handles and display names." (url (caddr candidate))) (propertize handle 'annot display-name 'meta url))) -(defun mastodon-toot--mentions-completion (command &optional arg &rest ignored) +(defun mastodon-toot-mentions (command &optional arg &rest ignored) "A company completion backend for toot mentions." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'mastodon-toot--mentions-completion)) + (interactive (company-begin-backend 'mastodon-toot-mentions)) (prefix (when (and (bound-and-true-p mastodon-toot-mode) ; if masto toot minor mode (save-excursion (forward-whitespace -1) @@ -613,9 +621,10 @@ The prefix can match against both user handles and display names." (mastodon-toot--update-status-fields)) (defun mastodon-toot--attach-media (file content-type description) - "Prompt for a attachment FILE of CONTENT-TYPE with DESCRIPTION. -A preview is displayed in the toot create buffer, and the file -will be uploaded and attached to the toot upon sending." + "Prompt for an attachment FILE of CONTENT-TYPE with DESCRIPTION. +A preview is displayed in the new toot buffer, and the file +is uploaded asynchronously using `mastodon-toot--upload-attached-media'. +File is actually attached to the toot upon posting." (interactive "fFilename: \nsContent type: \nsDescription: ") (when (>= (length mastodon-toot--media-attachments) 4) ;; Only a max. of 4 attachments are allowed, so pop the oldest one. @@ -626,21 +635,20 @@ will be uploaded and attached to the toot upon sending." (:content-type . ,content-type) (:description . ,description) (:filename . ,file))))) - (mastodon-toot--refresh-attachments-display)) - -(defun mastodon-toot--upload-attached-media () - "Actually upload attachments using `mastodon-http--post-media-attachment'. -The files to be uploaded are in `mastodon-toot--media-attachments'. -The items' ids are added to `mastodon-toot--media-attachment-ids', -which are used to attach them to a toot after uploading." - (mapcar (lambda (attachment) - (let* ((filename (expand-file-name - (alist-get :filename attachment))) - (caption (alist-get :description attachment)) - (url (concat mastodon-instance-url "/api/v2/media"))) - (message "Uploading %s..." (file-name-nondirectory filename)) - (mastodon-http--post-media-attachment url filename caption))) - mastodon-toot--media-attachments)) + (mastodon-toot--refresh-attachments-display) + ;; upload only most recent attachment: + (mastodon-toot--upload-attached-media (car (last mastodon-toot--media-attachments)))) + +(defun mastodon-toot--upload-attached-media (attachment) + "Upload a single attachment using `mastodon-http--post-media-attachment'. +The item's id is added to `mastodon-toot--media-attachment-ids', +which is used to attach it to a toot when posting." + (let* ((filename (expand-file-name + (alist-get :filename attachment))) + (caption (alist-get :description attachment)) + (url (concat mastodon-instance-url "/api/v2/media"))) + (message "Uploading %s..." (file-name-nondirectory filename)) + (mastodon-http--post-media-attachment url filename caption))) (defun mastodon-toot--refresh-attachments-display () "Update the display attachment previews in toot draft buffer." @@ -856,7 +864,7 @@ REPLY-JSON is the full JSON of the toot being replied to." (when (require 'company nil :noerror) (when mastodon-toot--enable-completion-for-mentions (set (make-local-variable 'company-backends) - (add-to-list 'company-backends 'mastodon-toot--mentions-completion)) + (add-to-list 'company-backends 'mastodon-toot-mentions)) (company-mode-on))) (make-local-variable 'after-change-functions) (push #'mastodon-toot--update-status-fields after-change-functions) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 826787a..662b691 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -145,7 +145,7 @@ Use. e.g. \"%c\" for your locale's date and time format." (define-key map (kbd "C-S-B") #'mastodon-tl--unblock-user) (define-key map (kbd "M") #'mastodon-tl--mute-user) (define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user) - (define-key map (kbd "C-S-P") #'mastodon-profile--my-profile) + (define-key map (kbd "O") #'mastodon-profile--my-profile) (define-key map (kbd "S") #'mastodon-search--search-query) (define-key map (kbd "d") #'mastodon-toot--delete-toot) (define-key map (kbd "D") #'mastodon-toot--delete-and-redraft-toot) @@ -223,7 +223,9 @@ If REPLY-JSON is the json of the toot being replied to." ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () (when (require 'emojify nil :noerror) - (emojify-mode t)))) + (emojify-mode t) + (when mastodon-toot--enable-custom-instance-emoji + (mastodon-toot--enable-custom-emoji))))) (define-derived-mode mastodon-mode special-mode "Mastodon" "Major mode for Mastodon, the federated microblogging network." diff --git a/test/fixture b/test/fixture new file mode 120000 index 0000000..f418013 --- /dev/null +++ b/test/fixture @@ -0,0 +1 @@ +../fixture
\ No newline at end of file diff --git a/test/mastodon-auth-test.el b/test/mastodon-auth-test.el deleted file mode 100644 index 9a765b9..0000000 --- a/test/mastodon-auth-test.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; mastodon-auth--test.el --- Tests for mastodon-auth -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Ian Eure - -;; Author: Ian Eure <ian@retrospec.tv> -;; Version: 0.9.1 -;; Homepage: https://github.com/jdenen/mastodon.el -;; Package-Requires: ((emacs "26.1")) - -;; This file is not part of GNU Emacs. - -;; This file is part of mastodon.el. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; mastodon-auth--test.el provides ERT tests for mastodon-auth.el - -;;; Code: - -(require 'ert) - -(ert-deftest mastodon-auth--handle-token-response--good () - (should (string= "foo" (mastodon-auth--handle-token-response '(:access_token "foo" :token_type "Bearer" :scope "read write follow" :created_at 0))))) - -(ert-deftest mastodon-auth--handle-token-response--unknown () - :expected-result :failed - (mastodon-auth--handle-token-response '(:herp "derp"))) - -(ert-deftest mastodon-auth--handle-token-response--failure () - :expected-result :failed - (mastodon-auth--handle-token-response '(:error "invalid_grant" :error_description "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client."))) - -(provide 'mastodon-auth--test) -;;; mastodon-auth--test.el ends here diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index 69c34a4..6a090b7 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -1,66 +1,105 @@ +;;; mastodon-auth-test.el --- Tests for mastodon-auth.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest generate-token--no-storing-credentials () +(ert-deftest mastodon-auth--handle-token-response--good () + "Should extract the access token from a good response." + (should + (string= + "foo" + (mastodon-auth--handle-token-response + '(:access_token "foo" :token_type "Bearer" :scope "read write follow" :created_at 0))))) + +(ert-deftest mastodon-auth--handle-token-response--unknown () + "Should throw an error when the response is unparsable." + (should + (equal + '(error "Unknown response from mastodon-auth--get-token!") + (condition-case error + (progn + (mastodon-auth--handle-token-response '(:herp "derp")) + nil) + (t error))))) + +(ert-deftest mastodon-auth--handle-token-response--failure () + "Should throw an error when the response indicates an error." + (let ((error-message "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client.")) + (should + (equal + `(error ,(format "Mastodon-auth--access-token: invalid_grant: %s" error-message)) + (condition-case error + (mastodon-auth--handle-token-response + `(:error "invalid_grant" :error_description ,error-message)) + (t error)))))) + +(ert-deftest mastodon-auth--generate-token--no-storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock - (let ((mastodon-auth-source-file "") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (read-string "Email: " user-mail-address) => "foo@bar.com") - (mock (read-passwd "Password: ") => "password") - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) + (let ((mastodon-auth-source-file "") + (mastodon-instance-url "https://instance.url")) + (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) + (mock (read-string "Email: " user-mail-address) => "foo@bar.com") + (mock (read-passwd "Password: ") => "password") + (mock (mastodon-http--post "https://instance.url/oauth/token" + '(("client_id" . "id") + ("client_secret" . "secret") + ("grant_type" . "password") + ("username" . "foo@bar.com") + ("password" . "password") + ("scope" . "read write follow")) + nil + :unauthenticated)) + (mastodon-auth--generate-token)))) -(ert-deftest generate-token--storing-credentials () +(ert-deftest mastodon-auth--generate-token--storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock - (let ((mastodon-auth-source-file "~/.authinfo") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (auth-source-search :create t - :host "https://instance.url" - :port 443 - :require '(:user :secret)) - => '((:user "foo@bar.com" :secret (lambda () "password")))) - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) + (let ((mastodon-auth-source-file "~/.authinfo") + (mastodon-instance-url "https://instance.url")) + (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) + (mock (auth-source-search :create t + :host "https://instance.url" + :port 443 + :require '(:user :secret)) + => '((:user "foo@bar.com" :secret (lambda () "password")))) + (mock (mastodon-http--post "https://instance.url/oauth/token" + '(("client_id" . "id") + ("client_secret" . "secret") + ("grant_type" . "password") + ("username" . "foo@bar.com") + ("password" . "password") + ("scope" . "read write follow")) + nil + :unauthenticated)) + (mastodon-auth--generate-token)))) -(ert-deftest get-token () +(ert-deftest mastodon-auth--get-token () "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 () +(ert-deftest mastodon-auth--access-token-found () "Should return value in `mastodon-auth--token-alist' if found." (let ((mastodon-instance-url "https://instance.url") (mastodon-auth--token-alist '(("https://instance.url" . "foobar")) )) - (should (string= (mastodon-auth--access-token) "foobar")))) + (should + (string= (mastodon-auth--access-token) "foobar")))) -(ert-deftest access-token-2 () +(ert-deftest mastodon-auth--access-token-not-found () "Should set and return `mastodon-auth--token' if nil." (let ((mastodon-instance-url "https://instance.url") - (mastodon-auth--token nil)) + (mastodon-auth--token-alist 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 d7f750d..9123286 100644 --- a/test/mastodon-client-tests.el +++ b/test/mastodon-client-tests.el @@ -1,39 +1,41 @@ +;;; mastodon-client-test.el --- Tests for mastodon-client.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest register () +(ert-deftest mastodon-client--register () "Should POST to /apps." (with-mock - (mock (mastodon-http--api "apps") => "https://instance.url/api/v1/apps") - (mock (mastodon-http--post "https://instance.url/api/v1/apps" - '(("client_name" . "mastodon.el") - ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") - ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) - nil - :unauthenticated)) - (mastodon-client--register))) + (mock (mastodon-http--api "apps") => "https://instance.url/api/v1/apps") + (mock (mastodon-http--post "https://instance.url/api/v1/apps" + '(("client_name" . "mastodon.el") + ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") + ("scopes" . "read write follow") + ("website" . "https://github.com/jdenen/mastodon.el")) + nil + :unauthenticated)) + (mastodon-client--register))) -(ert-deftest fetch () +(ert-deftest mastodon-client--fetch () "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 () +(ert-deftest mastodon-client--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 () +(ert-deftest mastodon-client--store-2 () "Should store client in `mastodon-client--token-file'." (let* ((mastodon-instance-url "http://mastodon.example") (plstore (plstore-open "stubfile.plstore")) @@ -42,62 +44,62 @@ (should (string= (plist-get client :client_id) "id")) (should (string= (plist-get client :client_secret) "secret")))) -(ert-deftest read-finds-match () +(ert-deftest mastodon-client--read-finds-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.example")) (with-mock - (mock (mastodon-client--token-file) => "fixture/client.plstore") - (should (equal (mastodon-client--read) - '(:client_id "id2" :client_secret "secret2")))))) + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--read) + '(:client_id "id2" :client_secret "secret2")))))) -(ert-deftest read-finds-no-match () +(ert-deftest mastodon-client--read-finds-no-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.social")) (with-mock - (mock (mastodon-client--token-file) => "fixture/client.plstore") - (should (equal (mastodon-client--read) nil))))) + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--read) nil))))) -(ert-deftest read-empty-store () +(ert-deftest mastodon-client--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 () +(ert-deftest mastodon-client--client-set-and-matching () "Should return `mastondon-client' if `mastodon-client--client-details-alist' is non-nil and instance url is included." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist '(("https://other.example" . :no-match) ("http://mastodon.example" . :matches)))) (should (eq (mastodon-client) :matches)))) -(ert-deftest client-set-but-not-matching () +(ert-deftest mastodon-client--client-set-but-not-matching () "Should read from `mastodon-token-file' if wrong data is cached." (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 () +(ert-deftest mastodon-client--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 () +(ert-deftest mastodon-client--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 03d4f94..00e1f41 100644 --- a/test/mastodon-http-tests.el +++ b/test/mastodon-http-tests.el @@ -1,9 +1,10 @@ +;;; mastodon-http-test.el --- Tests for mastodon-http.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest mastodon-http:get:retrieves-endpoint () +(ert-deftest mastodon-http--get-retrieves-endpoint () "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")))) + (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"))) diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index b537dfe..0e1152a 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -1,209 +1,246 @@ +;;; mastodon-media-test.el --- Tests for mastodon-media.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest mastodon-media:get-avatar-rendering () +(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")) + (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" + "http://example.org/remote/img.png" + "image")) (result-no-properties (substring-no-properties result)) (properties (text-properties-at 0 result))) - (should (string= " " result-no-properties)) + (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 'avatar (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display)))))) - -(ert-deftest mastodon-media:get-media-link-rendering () + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) + (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) + (should (string= "image" (plist-get properties 'mastodon-media-type))) + (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" + (plist-get properties 'help-echo)))))) + +(ert-deftest mastodon-media:get-media-link-rendering-gif () "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 + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png" + "gifv")) (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 (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) + (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) + (should (string= "gifv" (plist-get properties 'mastodon-media-type))) + (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview\ntype: gifv" + (plist-get properties 'help-echo)))))) + +(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))))))) - -(ert-deftest mastodon-media:load-image-from-url:avatar-without-imagemagic () + (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))))))) - -(ert-deftest mastodon-media:load-image-from-url:media-link-with-imagemagic () + (mock (image-type-available-p 'imagemagick) => nil) + (mock (image-transforms-p) => 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)))))))) - -(ert-deftest mastodon-media:load-image-from-url:media-link-without-imagemagic () + (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)))))))) - -(ert-deftest mastodon-media:load-image-from-url:url-fetching-fails () + (mock (image-type-available-p 'imagemagick) => nil) + (mock (image-transforms-p) => 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))))))) - -(ert-deftest mastodon-media:process-image-response () + (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)) - used-marker - saved-marker) - (insert "start:") - (setq used-marker (copy-marker (point)) - saved-marker (copy-marker (point))) - ;; Mock needed for the preliminary image created in - ;; mastodon-media--get-avatar-rendering - (stub create-image => :fake-image) - (insert (mastodon-media--get-avatar-rendering - "http://example.org/image.png.") - ":end") - (with-temp-buffer - (insert "some irrelevant\n" - "http headers\n" - "which will be ignored\n\n" - "fake\nimage\ndata") - (goto-char (point-min)) - - (mock (create-image - "fake\nimage\ndata" - (when (version< emacs-version "27.1") 'imagemagick) - t ':image :option) => :fake-image) - - (mastodon-media--process-image-response - () used-marker '(:image :option) 1 "http://example.org/image.png") - - ;; the used marker has been unset: - (should (null (marker-position used-marker))) - ;; the media-state has been set to loaded and the image is being displayed - (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) - (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) - -(ert-deftest mastodon-media:inline-images () + (let ((source-buffer (current-buffer)) + used-marker + saved-marker) + (insert "start:") + (setq used-marker (copy-marker (point)) + saved-marker (copy-marker (point))) + ;; Mock needed for the preliminary image created in + ;; mastodon-media--get-avatar-rendering + (stub create-image => :fake-image) + (insert (mastodon-media--get-avatar-rendering + "http://example.org/image.png.") + ":end") + (with-temp-buffer + (insert "some irrelevant\n" + "http headers\n" + "which will be ignored\n\n" + "fake\nimage\ndata") + (goto-char (point-min)) + + (mock (create-image + "fake\nimage\ndata" + (when (version< emacs-version "27.1") 'imagemagick) + t ':image :option) => :fake-image) + + (mastodon-media--process-image-response + () used-marker '(:image :option) 1 "http://example.org/image.png") + + ;; the used marker has been unset: + (should (null (marker-position used-marker))) + ;; the media-state has been set to loaded and the image is being displayed + (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) + (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) + +(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 3047ae6..4804e10 100644 --- a/test/mastodon-notifications-test.el +++ b/test/mastodon-notifications-test.el @@ -1,8 +1,10 @@ +;;; mastodon-notifications-test.el --- Tests for mastodon-notifications.el -*- lexical-binding: nil -*- + (require 'cl-lib) (require 'cl-macs) (require 'el-mock) -(defconst mastodon-notifications-test-base-mentioned +(defconst mastodon-notifications--test-base-mentioned '((id . "1234") (type . "mention") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -43,7 +45,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-favourite +(defconst mastodon-notifications--test-base-favourite '((id . "1234") (type . "favourite") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -84,7 +86,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-boosted +(defconst mastodon-notifications--test-base-boosted '((id . "1234") (type . "reblog") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -125,7 +127,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-followed +(defconst mastodon-notifications--test-base-followed '((id . "1234") (type . "follow") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -166,7 +168,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-favourite +(defconst mastodon-notifications--test-base-favourite '((id . "1234") (type . "mention") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -181,12 +183,12 @@ (statuses_count . 101) (note . "E")))) -(ert-deftest notification-get () +(ert-deftest mastodon-notifications--notification-get () "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. @@ -208,6 +210,8 @@ notification to be tested." (string= " Favourited your status from" (mastodon-notifications--byline-concat "Favourited")) (string= " Boosted your status from" - (mastodon-notifications--byline-concat "Boosted"))))) + (mastodon-notifications--byline-concat "Boosted")) + (string= " Posted a post" + (mastodon-notifications--byline-concat "Posted"))))) diff --git a/test/mastodon-search-tests.el b/test/mastodon-search-tests.el index b8521f3..996f786 100644 --- a/test/mastodon-search-tests.el +++ b/test/mastodon-search-tests.el @@ -1,4 +1,4 @@ - +;;; mastodon-search-test.el --- Tests for mastodon-search.el -*- lexical-binding: nil -*- (defconst mastodon-search--single-account-query '((id . "242971") @@ -37,10 +37,18 @@ (verified_at))])) "A sample mastodon account search result (parsed json)") -(defconst mastodon-search-test-single-tag - '((name . "TeamBringBackVisibleScrollbars") (url . "https://todon.nl/tags/TeamBringBackVisibleScrollbars") (history . [((day . "1636156800") (uses . "0") (accounts . "0")) ((day . "1636070400") (uses . "0") (accounts . "0")) ((day . "1635984000") (uses . "0") (accounts . "0")) ((day . "1635897600") (uses . "0") (accounts . "0")) ((day . "1635811200") (uses . "0") (accounts . "0")) ((day . "1635724800") (uses . "0") (accounts . "0")) ((day . "1635638400") (uses . "0") (accounts . "0"))]))) +(defconst mastodon-search--test-single-tag + '((name . "TeamBringBackVisibleScrollbars") + (url . "https://todon.nl/tags/TeamBringBackVisibleScrollbars") + (history . [((day . "1636156800") (uses . "0") (accounts . "0")) + ((day . "1636070400") (uses . "0") (accounts . "0")) + ((day . "1635984000") (uses . "0") (accounts . "0")) + ((day . "1635897600") (uses . "0") (accounts . "0")) + ((day . "1635811200") (uses . "0") (accounts . "0")) + ((day . "1635724800") (uses . "0") (accounts . "0")) + ((day . "1635638400") (uses . "0") (accounts . "0"))]))) -(defconst mastodon-search-test-single-status +(defconst mastodon-search--test-single-status '((id . "107230316503209282") (created_at . "2021-11-06T13:19:40.628Z") (in_reply_to_id) @@ -83,59 +91,57 @@ (following_count . 634) (statuses_count . 3807) (last_status_at . "2021-11-05") - (emojis . - []) - (fields . - [((name . "dark to") - (value . "themselves") - (verified_at)) - ((name . "its raining") - (value . "plastic") - (verified_at)) - ((name . "dis") - (value . "integration") - (verified_at)) - ((name . "ungleichzeitigkeit und") - (value . "gleichzeitigkeit, philosophisch") - (verified_at))])) - (media_attachments . - []) - (mentions . - [((id . "242971") - (username . "mousebot") - (url . "https://todon.nl/@mousebot") - (acct . "mousebot"))]) - (tags . - []) - (emojis . - []) + (emojis . []) + (fields . [((name . "dark to") + (value . "themselves") + (verified_at)) + ((name . "its raining") + (value . "plastic") + (verified_at)) + ((name . "dis") + (value . "integration") + (verified_at)) + ((name . "ungleichzeitigkeit und") + (value . "gleichzeitigkeit, philosophisch") + (verified_at))])) + (media_attachments . []) + (mentions . [((id . "242971") + (username . "mousebot") + (url . "https://todon.nl/@mousebot") + (acct . "mousebot"))]) + (tags . []) + (emojis . []) (card) (poll))) -(ert-deftest mastodon-search-test-get-user-info-@ () +(ert-deftest mastodon-search--get-user-info-@ () "Should build a list from a single account for company completion." - (let ((account mastodon-search--single-account-query)) - (should (equal (mastodon-search--get-user-info-@ account) - '(": ( ) { : | : & } ; :" "@mousebot" "https://todon.nl/@mousebot"))))) + (should + (equal + (mastodon-search--get-user-info-@ mastodon-search--single-account-query) + '(": ( ) { : | : & } ; :" "@mousebot" "https://todon.nl/@mousebot")))) -(ert-deftest mastodon-search-test-get-user-info () +(ert-deftest mastodon-search--get-user-info () "Should build a list from a single account for company completion." - (let ((account mastodon-search--single-account-query)) - (should (equal (mastodon-search--get-user-info account) - '(": ( ) { : | : & } ; :" "mousebot" "https://todon.nl/@mousebot"))))) + (should + (equal + (mastodon-search--get-user-info mastodon-search--single-account-query) + '(": ( ) { : | : & } ; :" "mousebot" "https://todon.nl/@mousebot")))) -(ert-deftest mastodon-search-test-get-hashtag-info () +(ert-deftest mastodon-search--get-hashtag-info () "Should build a list of hashtag name and URL." - (let ((tag mastodon-search-test-single-tag)) - (should (equal (mastodon-search--get-hashtag-info tag) - '("TeamBringBackVisibleScrollbars" - "https://todon.nl/tags/TeamBringBackVisibleScrollbars"))))) + (should + (equal + (mastodon-search--get-hashtag-info mastodon-search--test-single-tag) + '("TeamBringBackVisibleScrollbars" + "https://todon.nl/tags/TeamBringBackVisibleScrollbars")))) -(ert-deftest mastodon-search-test-get-status-info () +(ert-deftest mastodon-search--get-status-info () "Should return a list of ID, timestamp, content, and spoiler." - (let ((status mastodon-search-test-single-status)) - (should (equal (mastodon-search--get-status-info status) - '("107230316503209282" - "2021-11-06T13:19:40.628Z" - "" - "<p>This is a nice test toot, for testing purposes. Thank you.</p>"))))) + (should + (equal + (mastodon-search--get-status-info mastodon-search--test-single-status) + '("107230316503209282" + "2021-11-06T13:19:40.628Z" + "" + "<p>This is a nice test toot, for testing purposes. Thank you.</p>")))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 4edf5d5..da3b315 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1,3 +1,5 @@ +;;; mastodon-tl-test.el --- Tests for mastodon-tl.el -*- lexical-binding: nil -*- + (require 'cl-lib) (require 'cl-macs) (require 'el-mock) @@ -89,64 +91,64 @@ (reblogged))) "A sample reblogged/boosted toot (parsed json)") -(ert-deftest remove-html-1 () +(ert-deftest mastodon-tl--remove-html-1 () "Should remove all <span> tags." (let ((input "<span class=\"h-card\">foobar</span> <span>foobaz</span>")) (should (string= (mastodon-tl--remove-html input) "foobar foobaz")))) -(ert-deftest remove-html-2 () +(ert-deftest mastodon-tl--remove-html-2 () "Should replace <\p> tags with two new lines." (let ((input "foobar</p>")) (should (string= (mastodon-tl--remove-html input) "foobar\n\n")))) -(ert-deftest toot-id-boosted () +(ert-deftest mastodon-tl--toot-id-boosted () "If a toot is boostedm, return the reblog id." (should (string= (mastodon-tl--as-string (mastodon-tl--toot-id mastodon-tl-test-base-boosted-toot)) "4543919"))) -(ert-deftest toot-id () +(ert-deftest mastodon-tl--toot-id () "If a toot is boostedm, return the reblog id." (should (string= (mastodon-tl--as-string (mastodon-tl--toot-id mastodon-tl-test-base-toot)) "61208"))) -(ert-deftest as-string-1 () +(ert-deftest mastodon-tl--as-string-1 () "Should accept a string or number and return a string." (let ((id "1000")) (should (string= (mastodon-tl--as-string id) id)))) -(ert-deftest as-string-2 () +(ert-deftest mastodon-tl--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))))) -(ert-deftest more-json () +(ert-deftest mastodon-tl--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 () +(ert-deftest mastodon-tl--more-json-id-string () "Should request toots older than max_id. `mastodon-tl--more-json' should accept and id that is either 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 () +(ert-deftest mastodon-tl--update-json-id-string () "Should request toots more recent than since_id. `mastodon-tl--updated-json' should accept and id that is either 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" @@ -253,39 +255,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 +297,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 +314,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 +332,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 +351,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 +385,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,18 +410,18 @@ 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)) - "(B) (F) 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") + + (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 +431,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 +456,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 +498,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 () @@ -691,20 +693,20 @@ a string or a numeric." (list 'r3 r3 r2 r3) (list 'end end r3 end)))) (with-mock - (stub message => nil) ;; don't mess up our test output with the function's messages - (cl-dolist (test test-cases) - (let ((test-name (cl-first test)) - (test-start (cl-second test)) - (expected-prev (cl-third test)) - (expected-next (cl-fourth test))) - (goto-char test-start) - (mastodon-tl--previous-tab-item) - (should (equal (list 'prev test-name expected-prev) - (list 'prev test-name (point)))) - (goto-char test-start) - (mastodon-tl--next-tab-item) - (should (equal (list 'next test-name expected-next) - (list 'next test-name (point))))))))))) + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) (ert-deftest mastodon-tl--next-tab-item--no-spaces-at-ends () "Should do the correct tab actions even with regions right at buffer ends." @@ -739,20 +741,20 @@ a string or a numeric." (list 'gap2 gap2 r3 r4) (list 'r4 r4 r3 r4)))) (with-mock - (stub message => nil) ;; don't mess up our test output with the function's messages - (cl-dolist (test test-cases) - (let ((test-name (cl-first test)) - (test-start (cl-second test)) - (expected-prev (cl-third test)) - (expected-next (cl-fourth test))) - (goto-char test-start) - (mastodon-tl--previous-tab-item) - (should (equal (list 'prev test-name expected-prev) - (list 'prev test-name (point)))) - (goto-char test-start) - (mastodon-tl--next-tab-item) - (should (equal (list 'next test-name expected-next) - (list 'next test-name (point))))))))))) + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) (defun tl-tests--property-values-at (property ranges) @@ -781,33 +783,33 @@ constant." (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" @@ -833,10 +835,10 @@ constant." (insert "some text before\n") (setq toot-start (point)) (with-mock - (stub create-image => '(image "fake data")) - (stub shr-render-region => nil) ;; Travis's Emacs doesn't have libxml - (insert - (mastodon-tl--spoiler normal-toot-with-spoiler))) + (stub create-image => '(image "fake data")) + (stub shr-render-region => nil) ;; Travis's Emacs doesn't have libxml + (insert + (mastodon-tl--spoiler normal-toot-with-spoiler))) (setq toot-end (point)) (insert "\nsome more text.") (add-text-properties @@ -899,10 +901,10 @@ constant." 'help-echo "https://example.space/tags/sampletag") " some text after")) (rendered (with-mock - (stub shr-render-region => nil) - (mastodon-tl--render-text - fake-input-text - mastodon-tl-test-base-toot))) + (stub shr-render-region => nil) + (mastodon-tl--render-text + fake-input-text + mastodon-tl-test-base-toot))) (tag-location 7)) (should (eq (get-text-property tag-location 'mastodon-tab-stop rendered) 'hashtag)) @@ -912,23 +914,27 @@ constant." "Browse tag #sampletag")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-mastodon-link () + "Should extract the hashtag from a tags url." (should (equal (mastodon-tl--extract-hashtag-from-url "https://example.org/tags/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-other-link () + "Should extract the hashtag from a tag url." (should (equal (mastodon-tl--extract-hashtag-from-url "https://example.org/tag/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-wrong-instance () + "Should not find a tag when the instance doesn't match." (should (null (mastodon-tl--extract-hashtag-from-url "https://example.org/tags/foo" "https://other.example.org")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-not-tag () + "Should not find a hashtag when not a tag url" (should (null (mastodon-tl--extract-hashtag-from-url "https://example.org/@userid" "https://example.org")))) @@ -946,10 +952,10 @@ constant." 'help-echo "https://bar.example/@foo") " some text after")) (rendered (with-mock - (stub shr-render-region => nil) - (mastodon-tl--render-text - fake-input-text - mastodon-tl-test-base-toot))) + (stub shr-render-region => nil) + (mastodon-tl--render-text + fake-input-text + mastodon-tl-test-base-toot))) (mention-location 11)) (should (eq (get-text-property mention-location 'mastodon-tab-stop rendered) 'user-handle)) @@ -957,17 +963,20 @@ constant." "Browse user profile of @foo@bar.example")))) (ert-deftest mastodon-tl--extract-userhandle-from-url-correct-case () + "Should extract the user handle from url." (should (equal (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser" "@SomeUser") "@SomeUser@example.org"))) (ert-deftest mastodon-tl--extract-userhandle-from-url-missing-at-in-text () + "Should not extract a user handle from url if the text is wrong." (should (null (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser" "SomeUser")))) (ert-deftest mastodon-tl--extract-userhandle-from-url-query-in-url () + "Should not extract a user handle from url if there is a query param." (should (null (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser?shouldnot=behere" "SomeUser")))) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index abc66d0..804c55a 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -1,6 +1,8 @@ +;;; mastodon-toot-test.el --- Tests for mastodon-toot.el -*- lexical-binding: nil -*- + (require 'el-mock) -(defconst mastodon-toot-multi-mention +(defconst mastodon-toot--multi-mention '((mentions . [((id . "1") (username . "federated") @@ -18,29 +20,38 @@ (defconst mastodon-toot-no-mention '((mentions . []))) -(ert-deftest toot-multi-mentions () +(ert-deftest mastodon-toot--multi-mentions () + "Should build a correct mention string from the test toot data. + +Even the local name \"local\" gets a domain name added." (let ((mastodon-auth--acct-alist '(("https://local.social". "null"))) (mastodon-instance-url "https://local.social")) (should (string= - (mastodon-toot--mentions mastodon-toot-multi-mention) + (mastodon-toot--mentions mastodon-toot--multi-mention) "@local@local.social @federated@federated.social @federated@federated.cafe ")))) -(ert-deftest toot-multi-mentions-with-name () +(ert-deftest mastodon-toot--multi-mentions-with-name () + "Should build a correct mention string omitting self. + +Here \"local\" is the user themselves and gets omitted from the +mention string." (let ((mastodon-auth--acct-alist '(("https://local.social". "local"))) (mastodon-instance-url "https://local.social")) (should (string= - (mastodon-toot--mentions mastodon-toot-multi-mention) + (mastodon-toot--mentions mastodon-toot--multi-mention) "@federated@federated.social @federated@federated.cafe ")))) -(ert-deftest toot-no-mention () +(ert-deftest mastodon-toot--no-mention () + "Should construct an empty mention string without mentions." (let ((mastodon-auth--acct-alist '(("https://local.social". "null"))) (mastodon-instance-url "https://local.social")) (should (string= (mastodon-toot--mentions mastodon-toot-no-mention) "")))) -(ert-deftest cancel () +(ert-deftest mastodon-toot--cancel () + "Should kill the buffer when cancelling the toot." (with-mock - (mock (kill-buffer-and-window)) - (mastodon-toot--cancel) - (mock-verify))) + (mock (kill-buffer-and-window)) + (mastodon-toot--cancel) + (mock-verify))) |