diff options
| -rw-r--r-- | README.org | 2 | ||||
| -rw-r--r-- | lisp/mastodon-discover.el | 29 | ||||
| -rw-r--r-- | lisp/mastodon-http.el | 73 | ||||
| -rw-r--r-- | lisp/mastodon-notifications.el | 25 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 96 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 451 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 79 | ||||
| -rw-r--r-- | lisp/mastodon.el | 3 | ||||
| -rw-r--r-- | test/mastodon-profile-tests.el | 4 | ||||
| -rw-r--r-- | test/mastodon-toot-tests.el | 11 |
10 files changed, 504 insertions, 269 deletions
@@ -133,7 +133,7 @@ take place if your =mastodon-token-file= does not contain =:client_id= and | | *Other views* | | =S= | search (posts, users, tags) (NB: only posts you have interacted with) | | =I=, =c=, =d= | view, create, and delete filters | -| =R=, =a=, =r= | view/accept/reject follow requests | +| =R=, =a=, =j= | view/accept/reject follow requests | | =G= | view follow suggestions | | =V= | view your favourited toots | | =K= | view bookmarked toots | diff --git a/lisp/mastodon-discover.el b/lisp/mastodon-discover.el index f33b25d..0ef64e2 100644 --- a/lisp/mastodon-discover.el +++ b/lisp/mastodon-discover.el @@ -51,10 +51,14 @@ ("b" "Boost" mastodon-toot--boost) ("f" "Favourite" mastodon-toot--favourite) ("c" "Toggle hidden text (CW)" mastodon-tl--toggle-spoiler-text-in-toot) + ("k" "Bookmark toot" mastodon-toot--bookmark-toot-toggle) + ("v" "Vote on poll" mastodon-tl--poll-vote) ("n" "Next" mastodon-tl--goto-next-toot) ("p" "Prev" mastodon-tl--goto-prev-toot) ("TAB" "Next link item" mastodon-tl--next-tab-item) ("S-TAB" "Prev link item" mastodon-tl--previous-tab-item) + (when (require 'mpv nil :noerror) + ("C-RET" "Play media" mastodon-tl--mpv-play-video-at-point)) ("t" "New toot" mastodon-toot) ("r" "Reply" mastodon-toot--reply) ("C" "Copy toot URL" mastodon-toot--copy-toot-url) @@ -62,10 +66,12 @@ ("D" "Delete and redraft (your) toot" mastodon-toot--delete-toot) ("i" "Pin/Unpin (your) toot" mastodon-toot--pin-toot-toggle) ("P" "View user profile" mastodon-profile--show-user) + (when (require 'lingva nil :noerror) + "s" "Translate toot at point" mastodon-toot--translate-toot-text) ("T" "View thread" mastodon-tl--thread) ("v" "Vote on poll" mastodon-tl--poll-vote)) - ("Timelines" - ("h" "View mode help/keybindings" describe-mode) + ("Views" + ("h/?" "View mode help/keybindings" describe-mode) ("#" "Tag search" mastodon-tl--get-tag-timeline) ("F" "Federated" mastodon-tl--get-federated-timeline) ("H" "Home" mastodon-tl--get-home-timeline) @@ -73,8 +79,13 @@ ("N" "Notifications" mastodon-notifications--get) ("u" "Update timeline" mastodon-tl--update) ("S" "Search" mastodon-search--search-query) - ("C-S-P" "Jump to your profile" mastodon-profile--my-profile) - ("K" "View bookmarks" mastodon-profile--view-bookmarks)) + ("O" "Jump to your profile" mastodon-profile--my-profile) + ("U" "Update your profile note" mastodon-profile--update-user-profile-note) + ("K" "View bookmarks" mastodon-profile--view-bookmarks) + ("V" "View favourites" mastodon-profile--view-favourites) + ("R" "View follow requests" mastodon-profile--view-follow-requests) + ("G" "View follow suggestions" mastodon-tl--get-follow-suggestions) + ("I" "View filters" mastodon-tl--view-filters)) ("Users" ("W" "Follow" mastodon-tl--follow-user) ("C-S-W" "Unfollow" mastodon-tl--unfollow-user) @@ -89,16 +100,10 @@ ("-" "zoom out" 'image-decrease-size) ("u" "copy URL" 'shr-maybe-probe-and-copy-url)) ("Profile view" - ("g" "Show following" mastodon-profile--open-following) - ("s" "Show followers" mastodon-profile--open-followers) - ("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle) - ("R" "View follow requests" mastodon-profile--view-follow-requests) - ("a" "Accept follow request" mastodon-profile--follow-request-accept) - ("j" "Reject follow request" mastodon-profile--follow-request-reject) - ("U" "Update your profile note" mastodon-profile--update-user-profile-note)) + ("C-c C-c" "Cycle profile views" mastodon-profile-account-view-cycle)) ("Quit" ("q" "Quit mastodon and bury buffer." kill-this-buffer) ("Q" "Quit mastodon buffer and kill window." kill-buffer-and-window))))))) -(provide 'mastodon-discover) + (provide 'mastodon-discover) ;;; mastodon-discover.el ends here diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e3efabe..66707b7 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -148,25 +148,60 @@ SILENT means don't message." "GET" (mastodon-http--url-retrieve-synchronously url silent))) -(defun mastodon-http--get-json (url &optional silent) - "Make synchronous GET request to URL. Return JSON response. -SILENT means don't message." +(defun mastodon-http--get-response (url &optional no-headers silent vector) + "Make synchronous GET request to URL. Return JSON and response headers. +SILENT means don't message. +NO-HEADERS means don't collect http response headers. +VECTOR means return json arrays as vectors." (with-current-buffer (mastodon-http--get url silent) - (mastodon-http--process-json))) + (mastodon-http--process-response no-headers vector))) + +(defun mastodon-http--get-json (url &optional silent vector) + "Return only JSON data from URL request. +SILENT means don't message. +VECTOR means return json arrays as vectors." + (car (mastodon-http--get-response url :no-headers silent vector))) (defun mastodon-http--process-json () - "Process JSON response." + "Return only JSON data from async URL request. +Callback to `mastodon-http--get-json-async', usually +`mastodon-tl--init*', is run on the result." + (car (mastodon-http--process-response :no-headers))) + +(defun mastodon-http--process-response (&optional no-headers vector) + "Process http response. +Return a cons of JSON list and http response headers. +If NO-HEADERS is non-nil, just return the JSON. +VECTOR means return json arrays as vectors. +Callback to `mastodon-http--get-response-async', usually +`mastodon-tl--init*', is run on the result." ;; view raw response: ;; (switch-to-buffer (current-buffer)) + (let ((headers (unless no-headers + (mastodon-http--process-headers)))) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-array-type (if vector 'vector 'list)) + (json-string + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) + (kill-buffer) + (unless (or (string-empty-p json-string) (null json-string)) + `(,(json-read-from-string json-string) . ,headers))))) + +(defun mastodon-http--process-headers () + "Return an alist of http response headers." + (switch-to-buffer (current-buffer)) (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let ((json-string - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) - (kill-buffer) - (unless (or (string-empty-p json-string) (null json-string)) - (json-read-from-string json-string)))) + (let* ((head-str (buffer-substring-no-properties + (point-min) + (re-search-forward "^$" nil 'move))) + (head-list (split-string head-str "\n"))) + (mapcar (lambda (x) + (let ((list (split-string x ": "))) + (cons (car list) (cadr list)))) + head-list))) (defun mastodon-http--delete (url) "Make DELETE request to URL." @@ -241,8 +276,16 @@ Pass response buffer to CALLBACK function with args CBARGS." "GET" (url-retrieve url callback cbargs))) -(defun mastodon-http--get-json-async (url &optional callback &rest args) - "Make GET request to URL. Call CALLBACK with json-vector and ARGS." +(defun mastodon-http--get-response-async (url callback &rest args) + "Make GET request to URL. Call CALLBACK with http response and ARGS." + (mastodon-http--get-async + url + (lambda (status) + (when status ;; only when we actually get sth? + (apply callback (mastodon-http--process-response) args))))) + +(defun mastodon-http--get-json-async (url callback &rest args) + "Make GET request to URL. Call CALLBACK with json-list and ARGS." (mastodon-http--get-async url (lambda (status) diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index c0ca684..1ecdbfb 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -52,7 +52,6 @@ (autoload 'mastodon-tl--reload-timeline-or-profile "mastodon-tl") (defvar mastodon-tl--buffer-spec) (defvar mastodon-tl--display-media-p) -(defvar mastodon-tl--buffer-spec) (defvar mastodon-notifications--types-alist '(("mention" . mastodon-notifications--mention) @@ -87,7 +86,6 @@ With no argument, the request is accepted. Argument REJECT means reject the request. Can be called in notifications view or in follow-requests view." - (interactive) (if (not (mastodon-tl--find-property-range 'toot-json (point))) (message "No follow request at point?") (let* ((toot-json (mastodon-tl--property 'toot-json)) @@ -269,19 +267,20 @@ of the toot responded to." "notifications" 'mastodon-notifications--timeline)) -(defun mastodon-notifications-clear () +(defun mastodon-notifications--clear-all () "Clear all notifications." (interactive) - (let ((response - (mastodon-http--post (mastodon-http--api "notifications/clear") - nil nil))) - (mastodon-http--triage - response (lambda () - (when mastodon-tl--buffer-spec - (mastodon-tl--reload-timeline-or-profile)) - (message "All notifications cleared!"))))) - -(defun mastodon-notifications-clear-current-notif () + (when (y-or-n-p "Clear all notifications?") + (let ((response + (mastodon-http--post (mastodon-http--api "notifications/clear") + nil nil))) + (mastodon-http--triage + response (lambda () + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "All notifications cleared!")))))) + +(defun mastodon-notifications--clear-current () "Dismiss the notification at point." (interactive) (let* ((id (or (mastodon-tl--property 'toot-id) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 8d5bf36..63c062b 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -82,8 +82,11 @@ (defvar mastodon-profile-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "s") #'mastodon-profile--open-followers) - (define-key map (kbd "g") #'mastodon-profile--open-following) + ;; conflicts with `s' keybinding to translate toot at point + ;; seeing as we now have the C-c C-c cycle functionality, + ;; maybe we can retire both of these awful bindings + ;; (define-key map (kbd "s") #'mastodon-profile--open-followers) + ;; (define-key map (kbd "g") #'mastodon-profile--open-following) (define-key map (kbd "C-c C-c") #'mastodon-profile-account-view-cycle) map) "Keymap for `mastodon-profile-mode'.") @@ -91,7 +94,10 @@ (defvar mastodon-profile--view-follow-requests-keymap (let ((map ;(make-sparse-keymap))) (copy-keymap mastodon-mode-map))) - (define-key map (kbd "r") #'mastodon-notifications--follow-request-reject) + ;; make reject binding match the binding in notifs view + ;; 'r' is then reserved for replying, even tho it is not avail + ;; in foll-reqs view + (define-key map (kbd "j") #'mastodon-notifications--follow-request-reject) (define-key map (kbd "a") #'mastodon-notifications--follow-request-accept) (define-key map (kbd "n") #'mastodon-tl--goto-next-item) (define-key map (kbd "p") #'mastodon-tl--goto-prev-item) @@ -137,6 +143,11 @@ contains") (defun mastodon-profile--toot-json () "Get the next toot-json." (interactive) + ;; NB: we cannot add + ;; (or (mastodon-tl--property 'profile-json) + ;; here because it searches forward endlessly + ;; TODO: it would be nice to be able to do so tho + ;; or handle --property failing (mastodon-tl--property 'toot-json)) (defun mastodon-profile--make-author-buffer (account) @@ -183,7 +194,8 @@ contains") (message "Loading your favourited toots...") (mastodon-tl--init "favourites" "favourites" - 'mastodon-tl--timeline)) + 'mastodon-tl--timeline + :headers)) (defun mastodon-profile--view-bookmarks () "Open a new buffer displaying the user's bookmarks." @@ -296,30 +308,39 @@ This is done after changing the setting on the server." (setq mastodon-profile-account-settings (plist-put mastodon-profile-account-settings pref val))) -(defun mastodon-profile-fetch-server-account-settings () +(defun mastodon-profile-fetch-server-account-settings-maybe () + "Fetch account settings from the server. +Only do so if `mastodon-profile-account-settings' is nil." + (mastodon-profile-fetch-server-account-settings :no-force)) + +(defun mastodon-profile-fetch-server-account-settings (&optional no-force) "Fetch basic account settings from the server. Store the values in `mastodon-profile-account-settings'. -Run in `mastodon-mode-hook'." - (let ((keys '(locked discoverable display_name bot)) - (source-keys '(privacy sensitive language))) - (mapc (lambda (k) - (mastodon-profile-update-preference-plist - k - (mastodon-profile--get-json-value k))) - keys) - (mapc (lambda (sk) - (mastodon-profile-update-preference-plist - sk - (mastodon-profile--get-source-value sk))) - source-keys) - ;; hack for max toot chars: - (mastodon-toot--get-max-toot-chars :no-toot) - (mastodon-profile-update-preference-plist 'max_toot_chars - mastodon-toot--max-toot-chars) - ;; TODO: remove now redundant vars, replace with fetchers from the plist - (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) - mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) - mastodon-profile-account-settings)) +Run in `mastodon-mode-hook'. +If NO-FORCE, only fetch if `mastodon-profile-account-settings' is nil." + (unless + (and no-force + mastodon-profile-account-settings) + (let ((keys '(locked discoverable display_name bot)) + (source-keys '(privacy sensitive language))) + (mapc (lambda (k) + (mastodon-profile-update-preference-plist + k + (mastodon-profile--get-json-value k))) + keys) + (mapc (lambda (sk) + (mastodon-profile-update-preference-plist + sk + (mastodon-profile--get-source-value sk))) + source-keys) + ;; hack for max toot chars: + (mastodon-toot--get-max-toot-chars :no-toot) + (mastodon-profile-update-preference-plist 'max_toot_chars + mastodon-toot--max-toot-chars) + ;; TODO: remove now redundant vars, replace with fetchers from the plist + (setq mastodon-toot--visibility (mastodon-profile--get-pref 'privacy) + mastodon-toot--content-nsfw (mastodon-profile--get-pref 'sensitive)) + mastodon-profile-account-settings))) (defun mastodon-profile-account-locked-toggle () "Toggle the locked status of your account. @@ -465,7 +486,8 @@ This endpoint only holds a few preferences. For others, see (url (mastodon-http--api (format "accounts/relationships?id[]=%s" their-id)))) - (mastodon-http--get-json url))) + ;; FIXME: not sure why we need to do this for relationships only! + (car (mastodon-http--get-json url)))) (defun mastodon-profile--fields-get (&optional account fields) "Fetch the fields vector (aka profile metadata) from profile of ACCOUNT. @@ -527,11 +549,9 @@ FIELDS means provide a fields vector fetched by other means." account 'statuses_count))) (relationships (mastodon-profile--relationships-get id)) (followed-by-you (when (not (seq-empty-p relationships)) - (alist-get 'following - (aref relationships 0)))) + (alist-get 'following relationships))) (follows-you (when (not (seq-empty-p relationships)) - (alist-get 'followed_by - (aref relationships 0)))) + (alist-get 'followed_by relationships))) (followsp (or (equal follows-you 't) (equal followed-by-you 't))) (fields (mastodon-profile--fields-get account)) (pinned (mastodon-profile--get-statuses-pinned account))) @@ -556,7 +576,8 @@ FIELDS means provide a fields vector fetched by other means." (propertize (concat "\n" - (mastodon-profile--image-from-account account) + (mastodon-profile--image-from-account account 'avatar_static) + (mastodon-profile--image-from-account account 'header_static) "\n" (propertize (mastodon-profile--account-field account 'display_name) @@ -621,11 +642,12 @@ If toot is a boost, opens the profile of the booster." (mastodon-profile--make-author-buffer (alist-get 'account (mastodon-profile--toot-json)))) -(defun mastodon-profile--image-from-account (status) - "Generate an image from a STATUS." - (let ((url (alist-get 'avatar_static status))) - (unless (equal url "/avatars/original/missing.png") - (mastodon-media--get-media-link-rendering url)))) +(defun mastodon-profile--image-from-account (account img_type) + "Return a avatar image from ACCOUNT. +IMG_TYPE is the JSON key from the account data." + (let ((img (alist-get img_type account))) + (unless (equal img "/avatars/original/missing.png") + (mastodon-media--get-media-link-rendering img)))) (defun mastodon-profile--show-user (user-handle) "Query for USER-HANDLE from current status and show that user's profile." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 92fd12b..b352c6d 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -68,7 +68,8 @@ (autoload 'mastodon-http--delete "mastodon-http") (autoload 'mastodon-profile--view-author-profile "mastodon-profile") (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") - +(autoload 'mastodon-http--get-response-async "mastodon-http") +(autoload 'mastodon-url-lookup "mastodon") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -282,6 +283,18 @@ text, i.e. hidden spoiler text." (mastodon-tl--init (concat "tag-" tag) (concat "timelines/tag/" tag) 'mastodon-tl--timeline)) +(defun mastodon-tl--message-help-echo () + "Call message on 'help-echo property at point. +Do so if type of status at poins is not follow_request/follow." + (let ((type (alist-get + 'type + (get-text-property (point) 'toot-json))) + (echo (get-text-property (point) 'help-echo))) + (when echo ; not for followers/following in profile + (unless (or (string= type "follow_request") + (string= type "follow")) ; no counts for these + (message "%s" (get-text-property (point) 'help-echo)))))) + (defun mastodon-tl--goto-toot-pos (find-pos refresh &optional pos) "Search for toot with FIND-POS. If search returns nil, execute REFRESH function. @@ -294,7 +307,9 @@ Optionally start from POS." (if npos (if (not (get-text-property npos 'toot-id)) (mastodon-tl--goto-toot-pos find-pos refresh npos) - (goto-char npos)) + (goto-char npos) + ;; force display of help-echo on moving to a toot byline: + (mastodon-tl--message-help-echo)) (funcall refresh)))) (defun mastodon-tl--goto-next-toot () @@ -397,22 +412,23 @@ image media from the byline." toot) (alist-get 'reblog toot) ; boosts toot)) ; everything else - (fol-req-p (equal (alist-get 'type toot-to-count) "follow")) - (media-types (mastodon-tl--get-media-types toot)) - (format-faves (format "%s faves | %s boosts | %s replies" - (alist-get 'favourites_count toot-to-count) - (alist-get 'reblogs_count toot-to-count) - (alist-get 'replies_count toot-to-count))) - (format-media (when media-types - (format " | media: %s" - (mapconcat #'identity media-types " ")))) - (format-media-binding (when (and (or - (member "video" media-types) - (member "gifv" media-types)) - (require 'mpv nil :no-error)) - (format " | C-RET to view with mpv")))) + (fol-req-p (or (string= (alist-get 'type toot-to-count) "follow") + (string= (alist-get 'type toot-to-count) "follow_request")))) (unless fol-req-p - (format "%s" (concat format-faves format-media format-media-binding))))) + (let* ((media-types (mastodon-tl--get-media-types toot)) + (format-faves (format "%s faves | %s boosts | %s replies" + (alist-get 'favourites_count toot-to-count) + (alist-get 'reblogs_count toot-to-count) + (alist-get 'replies_count toot-to-count))) + (format-media (when media-types + (format " | media: %s" + (mapconcat #'identity media-types " ")))) + (format-media-binding (when (and (or + (member "video" media-types) + (member "gifv" media-types)) + (require 'mpv nil :no-error)) + (format " | C-RET to view with mpv")))) + (format "%s" (concat format-faves format-media format-media-binding)))))) (defun mastodon-tl--get-media-types (toot) "Return a list of the media attachment types of the TOOT at point." @@ -656,10 +672,18 @@ START and END are the boundaries of the link in the toot." (concat (url-type toot-url) "://" (url-host toot-url)) mastodon-instance-url)) + (link-str (buffer-substring-no-properties start end)) (maybe-hashtag (mastodon-tl--extract-hashtag-from-url url toot-instance-url)) - (maybe-userhandle (mastodon-tl--extract-userhandle-from-url - url (buffer-substring-no-properties start end)))) + (maybe-userhandle + (if (proper-list-p toot) ; fails for profile buffers? + (or (mastodon-tl--userhandle-from-mentions toot + link-str) + ;; FIXME: if prev always works, cut this: + (mastodon-tl--extract-userhandle-from-url + url link-str)) + (mastodon-tl--extract-userhandle-from-url + url link-str)))) (cond (;; Hashtags: maybe-hashtag (setq mastodon-tab-stop-type 'hashtag @@ -669,10 +693,9 @@ START and END are the boundaries of the link in the toot." (;; User handles: maybe-userhandle ;; this fails on mentions in profile notes: - (let ((maybe-userid - (when (proper-list-p toot) - (mastodon-tl--extract-userid-toot - toot maybe-userhandle)))) + (let ((maybe-userid (when (proper-list-p toot) + (mastodon-tl--extract-userid-toot + toot link-str)))) (setq mastodon-tab-stop-type 'user-handle keymap mastodon-tl--link-keymap help-echo (concat "Browse user profile of " maybe-userhandle) @@ -695,18 +718,33 @@ START and END are the boundaries of the link in the toot." 'help-echo help-echo) extra-properties)))) -(defun mastodon-tl--extract-userid-toot (toot acct) - "Extract a user id for an ACCT from mentions in a TOOT." - (let* ((mentions (append (alist-get 'mentions toot) nil)) - (mention (pop mentions)) - (short-acct (substring acct 1 (length acct))) - return) - (while mention - (when (string= (alist-get 'acct mention) - short-acct) - (setq return (alist-get 'id mention))) - (setq mention (pop mentions))) - return)) +(defun mastodon-tl--userhandle-from-mentions (toot link) + "Extract a user handle from mentions in json TOOT. +LINK is maybe the '@handle' to search for." + (mastodon-tl--extract-el-from-mentions 'acct toot link)) + +(defun mastodon-tl--extract-userid-toot (toot link) + "Extract a user id for an ACCT from mentions in a TOOT. +LINK is maybe the '@handle' to search for." + (mastodon-tl--extract-el-from-mentions 'id toot link)) + +(defun mastodon-tl--extract-el-from-mentions (el toot link) + "Extract element EL from TOOT mentions that matches LINK. +LINK should be a simple handle string with no domain, i.e. @user. +Return nil if no matching element" + ;; Must return nil if nothing found! + ;; TODO: we should break the while loop as soon as we get sth + (let ((mentions (append (alist-get 'mentions toot) nil))) + (when mentions + (let* ((mention (pop mentions)) + (name (substring-no-properties link 1 (length link))) ; cull @ + return) + (while mention + (when (string= (alist-get 'username mention) + name) + (setq return (alist-get el mention))) + (setq mention (pop mentions))) + return)))) (defun mastodon-tl--extract-userhandle-from-url (url buffer-text) "Return the user hande the URL points to or nil if it is not a profile link. @@ -800,8 +838,7 @@ Used for hitting <return> on a given link." (mastodon-tl--toggle-spoiler-text position)) ((eq link-type 'hashtag) (mastodon-tl--show-tag-timeline (get-text-property position 'mastodon-tag))) - ;; FIXME: 'account / 'account-id is not set for mentions - ;; only works for bylines, not mentions + ;; 'account / 'account-id is not set for mentions, only bylines ((eq link-type 'user-handle) (let ((account-json (get-text-property position 'account)) (account-id (get-text-property position 'account-id))) @@ -813,9 +850,17 @@ Used for hitting <return> on a given link." (mastodon-profile--make-author-buffer (mastodon-profile--account-from-id account-id))) (t - (mastodon-profile--make-author-buffer - (mastodon-profile--search-account-by-handle - (get-text-property position 'mastodon-handle))))))) + (let ((account + (mastodon-profile--search-account-by-handle + (get-text-property position 'mastodon-handle)))) + ;; never call make-author-buffer on nil account: + (if account + (mastodon-profile--make-author-buffer account) + ;; optional webfinger lookup: + (if (y-or-n-p + "Search for account returned nothing. Perform URL lookup?") + (mastodon-url-lookup (get-text-property position 'shr-url)) + (message "Unable to find account.")))))))) (t (error "Unknown link type %s" link-type))))) @@ -979,7 +1024,9 @@ this just means displaying toot client." options "\n") "\n" - (propertize (format "%s people | " vote-count) + (propertize (if (= vote-count 1) + (format "%s person | " vote-count) + (format "%s people | " vote-count)) 'face 'font-lock-comment-face) (let ((str (if expired-p "Poll expired." @@ -989,6 +1036,8 @@ this just means displaying toot client." (defun mastodon-tl--format-poll-expiry (timestamp) "Convert poll expiry TIMESTAMP into a descriptive string." + ;; TODO: this bugged when a timestamp was in the past + ;; despite the poll not being listed as expired (let ((parsed (ts-human-duration (ts-diff (ts-parse timestamp) (ts-now))))) (cond ((> (plist-get parsed :days) 0) @@ -1128,7 +1177,12 @@ Optionally set it for BUFFER." (defun mastodon-tl--buffer-name (&optional buffer) "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. Optionally get it for BUFFER." - (mastodon-tl--get-buffer-property 'buffer-name buffer )) + (mastodon-tl--get-buffer-property 'buffer-name buffer)) + +(defun mastodon-tl--link-header (&optional buffer) + "Get the BUFFER-NAME stored in `mastodon-tl--buffer-spec'. +Optionally get it for BUFFER." + (mastodon-tl--get-buffer-property 'link-header buffer)) (defun mastodon-tl--get-buffer-property (property &optional buffer) "Get PROPERTY from `mastodon-tl--buffer-spec' in BUFFER or `current-buffer'." @@ -1137,6 +1191,19 @@ Optionally get it for BUFFER." (error "Mastodon-tl--buffer-spec is not defined for buffer %s" (or buffer (current-buffer)))))) +(defun mastodon-tl--set-buffer-spec (buffer endpoint update-function + &optional link-header) + "Set `mastodon-tl--buffer-spec' for the current buffer. + +BUFFER is buffer name, ENDPOINT is buffer's enpoint, +UPDATE-FUNCTION is its update function. +LINK-HEADER is the http Link header if present." + (setq mastodon-tl--buffer-spec + `(buffer-name ,buffer + endpoint ,endpoint + update-function ,update-function + link-header ,link-header))) + (defun mastodon-tl--more-json (endpoint id) "Return JSON for timeline ENDPOINT before ID." (let* ((url (mastodon-http--api (concat @@ -1237,11 +1304,9 @@ ID is that of the toot to view." (with-output-to-temp-buffer buffer (switch-to-buffer buffer) (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s" id) - update-function - (lambda (toot) (message "END of thread.")))) + (mastodon-tl--set-buffer-spec buffer + (format "statuses/%s" id) + (lambda (_toot) (message "END of thread."))) (let ((inhibit-read-only t)) (mastodon-tl--toot toot :detailed-p)))))) @@ -1257,44 +1322,47 @@ ID is that of the toot to view." (mastodon-tl--property 'parent-toot))) (mastodon-tl--property 'base-toot-id)) (mastodon-tl--property 'base-toot-id)))) - (url (mastodon-http--api (format "statuses/%s/context" id))) - (buffer (format "*mastodon-thread-%s*" id)) - (toot - ;; refetch current toot in case we just faved/boosted: - (mastodon-http--get-json - (mastodon-http--api (concat "statuses/" id)) - :silent)) - (context (mastodon-http--get-json url :silent)) - (marker (make-marker))) - (if (equal (caar toot) 'error) - (message "Error: %s" (cdar toot)) - (when (member (alist-get 'type toot) '("reblog" "favourite")) - (setq toot (alist-get 'status toot))) - (if (> (+ (length (alist-get 'ancestors context)) - (length (alist-get 'descendants context))) - 0) - ;; if we have a thread: - (progn - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - (mastodon-mode) - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,(format "statuses/%s/context" id) - update-function - (lambda (toot) (message "END of thread.")))) - (let ((inhibit-read-only t)) - (mastodon-tl--timeline (alist-get 'ancestors context)) - (goto-char (point-max)) - (move-marker marker (point)) - ;; print re-fetched toot: - (mastodon-tl--toot toot :detailed-p) - (mastodon-tl--timeline (alist-get 'descendants context)))) - ;; put point at the toot: - (goto-char (marker-position marker)) - (mastodon-tl--goto-next-toot)) - ;; else just print the lone toot: - (mastodon-tl--single-toot id))))) + (type (mastodon-tl--field 'type (mastodon-tl--property 'toot-json)))) + (if (or (string= type "follow_request") + (string= type "follow")) ; no can thread these + (error "No thread") + (let* ((url (mastodon-http--api (format "statuses/%s/context" id))) + (buffer (format "*mastodon-thread-%s*" id)) + (toot + ;; refetch current toot in case we just faved/boosted: + (mastodon-http--get-json + (mastodon-http--api (concat "statuses/" id)) + :silent)) + (context (mastodon-http--get-json url :silent)) + (marker (make-marker))) + (if (equal (caar toot) 'error) + (message "Error: %s" (cdar toot)) + (when (member (alist-get 'type toot) '("reblog" "favourite")) + (setq toot (alist-get 'status toot))) + (if (> (+ (length (alist-get 'ancestors context)) + (length (alist-get 'descendants context))) + 0) + ;; if we have a thread: + (progn + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + (mastodon-mode) + (mastodon-tl--set-buffer-spec + buffer + (format "statuses/%s/context" id) + (lambda (_toot) (message "END of thread."))) + (let ((inhibit-read-only t)) + (mastodon-tl--timeline (alist-get 'ancestors context)) + (goto-char (point-max)) + (move-marker marker (point)) + ;; print re-fetched toot: + (mastodon-tl--toot toot :detailed-p) + (mastodon-tl--timeline (alist-get 'descendants context)))) + ;; put point at the toot: + (goto-char (marker-position marker)) + (mastodon-tl--goto-next-toot)) + ;; else just print the lone toot: + (mastodon-tl--single-toot id))))))) (defun mastodon-tl--create-filter () "Create a filter for a word. @@ -1455,7 +1523,9 @@ INSTANCE is an instance domain name." (if user (mastodon-http--api "instance") (concat instance - "/api/v1/instance"))))) + "/api/v1/instance")) + nil + :vector))) (when response (let ((buf (get-buffer-create "*mastodon-instance*"))) (with-current-buffer buf @@ -1538,7 +1608,7 @@ IND is the optional indentation level to print at." (when ind (indent-to ind)) (insert (mastodon-tl--format-key el pad) " " - (mastodon-tl--newline-if-long el) + (mastodon-tl--newline-if-long (cdr el)) ;; only send strings straight to --render-text ;; this makes hyperlinks work: (if (not (stringp val)) @@ -1548,25 +1618,36 @@ IND is the optional indentation level to print at." "\n")))))))) (defun mastodon-tl--print-instance-rules-or-fields (alist) - "Print ALIST of instance rules or contact account fields." - (let ((key (if (alist-get 'id alist) 'id 'name)) - (value (if (alist-get 'id alist) 'text 'value))) + "Print ALIST of instance rules or contact account or emoji fields." + (let ((key (cond ((alist-get 'id alist) + 'id) + ((alist-get 'name alist) + 'name) + ((alist-get 'shortcode alist) + 'shortcode))) + (value (cond ((alist-get 'id alist) + 'text) + ((alist-get 'value alist) + 'value) + ((alist-get 'url alist) + 'url)))) (indent-to 4) (insert (format "%-5s: " (propertize (alist-get key alist) 'face '(:underline t))) - (mastodon-tl--newline-if-long (assoc value alist)) - (format "%s" (mastodon-tl--render-text - (alist-get value alist))) - "\n"))) + (mastodon-tl--newline-if-long (alist-get value alist)) + (format "%s" (mastodon-tl--render-text + (alist-get value alist))) + "\n"))) (defun mastodon-tl--newline-if-long (el) "Return a newline string if the cdr of EL is over 50 characters long." - (if (and (sequencep (cdr el)) - (< 50 (length (cdr el)))) - "\n" - "")) + (let ((rend (if (stringp el) (mastodon-tl--render-text el) el))) + (if (and (sequencep rend) + (< 50 (length rend))) + "\n" + ""))) (defun mastodon-tl--follow-user (user-handle &optional notify) "Query for USER-HANDLE from current status and follow that user. @@ -1646,11 +1727,17 @@ Can be called to toggle NOTIFY on users already being followed." (equal (buffer-name) "*mastodon-follow-requests*") ;; profile view follows/followers compat: ;; but not for profile statuses: + ;; fetch 'toot-json: (and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) (not (string-suffix-p "statuses" (mastodon-tl--get-endpoint))))) - ;; avoid tl--property here because it calls next-toot - ;; which breaks non-toot buffers like foll reqs etc.: (list (alist-get 'acct (get-text-property (point) 'toot-json)))) + ;; profile view, no toots, point on profile note, ie. 'profile-json: + ;; needed for e.g. gup.pe groups which show no toots publically: + ((and (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + (get-text-property (point) 'profile-json)) + (list (alist-get 'acct (get-text-property (point) 'profile-json)))) + ;; avoid tl--property here because it calls next-toot + ;; which breaks non-toot buffers like foll reqs etc.: (t (mastodon-profile--extract-users-handles (mastodon-profile--toot-json)))))) @@ -1690,9 +1777,13 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." ;; if unmuting/unblocking, we got handle from mute/block list (mastodon-profile--search-account-by-handle user-handle) - ;; if muting/blocking, we select from handles in current status - (mastodon-profile--lookup-account-in-status - user-handle (mastodon-profile--toot-json)))) + ;; if profile view, use 'profile-json as status: + (if (string-prefix-p "accounts" (mastodon-tl--get-endpoint)) + (mastodon-profile--lookup-account-in-status + user-handle (get-text-property (point) 'profile-json)) + ;; if muting/blocking, we select from handles in current status + (mastodon-profile--lookup-account-in-status + user-handle (mastodon-profile--toot-json))))) (user-id (mastodon-profile--account-field account 'id)) (name (if (not (string-empty-p (mastodon-profile--account-field account 'display_name))) (mastodon-profile--account-field account 'display_name) @@ -1749,23 +1840,48 @@ For use after e.g. deleting a toot." (mastodon-tl--thread (match-string 2 (mastodon-tl--get-endpoint))))))) +(defun mastodon-tl--build-link-header-url (str) + "Return a URL from STR, an http Link header." + (let* ((split (split-string str "; ")) + (url-base (string-trim (car split) "<" ">")) + (param (cadr split))) + (concat url-base "&" param))) + (defun mastodon-tl--more () "Append older toots to timeline, asynchronously." (interactive) (message "Loading older toots...") - (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) - 'mastodon-tl--more* (current-buffer) (point))) - -(defun mastodon-tl--more* (json buffer point-before) + (if (string= (buffer-name (current-buffer)) "*mastodon-favourites*") + ;; link-header: can't build a URL with --more-json-async, endpoint/id: + (let* ((next (car (mastodon-tl--link-header))) + (prev (cadr (mastodon-tl--link-header))) + (url (mastodon-tl--build-link-header-url next))) + (mastodon-http--get-response-async url 'mastodon-tl--more* (current-buffer) + (point) :headers)) + (mastodon-tl--more-json-async (mastodon-tl--get-endpoint) (mastodon-tl--oldest-id) + 'mastodon-tl--more* (current-buffer) (point)))) + +(defun mastodon-tl--more* (response buffer point-before &optional headers) "Append older toots to timeline, asynchronously. -Runs the timeline's update function on JSON, in BUFFER. -When done, places point at POINT-BEFORE." +Runs the timeline's update function on RESPONSE, in BUFFER. +When done, places point at POINT-BEFORE. +HEADERS is the http headers returned in the response, if any." (with-current-buffer buffer - (when json - (let ((inhibit-read-only t)) + (when response + (let* ((inhibit-read-only t) + (json (if headers (car response) response)) + (headers (if headers (cdr response) nil)) + (link-header (mastodon-tl--get-link-header-from-response headers))) (goto-char (point-max)) (funcall (mastodon-tl--get-update-function) json) (goto-char point-before) + ;; update buffer spec to new link-header: + ;; (other values should just remain as they were) + (when headers + (mastodon-tl--set-buffer-spec (mastodon-tl--buffer-name) + (mastodon-tl--get-endpoint) + (mastodon-tl--get-update-function) + link-header)) (message "Loading older toots... done."))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) @@ -1926,58 +2042,67 @@ from the start if it is nil." (goto-char (or mastodon-tl--update-point (point-min))) (funcall update-function json))))) -(defun mastodon-tl--init (buffer-name endpoint update-function) - "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. +(defun mastodon-tl--get-link-header-from-response (headers) + "Get http Link header from list of http HEADERS." + (when headers + (split-string (alist-get "Link" headers nil nil 'equal) ", "))) -UPDATE-FUNCTION is used to recieve more toots." +(defun mastodon-tl--init (buffer-name endpoint update-function &optional headers) + "Initialize BUFFER-NAME with timeline targeted by ENDPOINT asynchronously. +UPDATE-FUNCTION is used to recieve more toots. +HEADERS means to also collect the response headers. Used for paginating +favourites." (let ((url (mastodon-http--api endpoint)) (buffer (concat "*mastodon-" buffer-name "*"))) - (mastodon-http--get-json-async - url 'mastodon-tl--init* buffer endpoint update-function))) + (if headers + (mastodon-http--get-response-async + url 'mastodon-tl--init* buffer endpoint update-function headers) + (mastodon-http--get-json-async + url 'mastodon-tl--init* buffer endpoint update-function)))) -(defun mastodon-tl--init* (json buffer endpoint update-function) +(defun mastodon-tl--init* (response buffer endpoint update-function &optional headers) "Initialize BUFFER with timeline targeted by ENDPOINT. - UPDATE-FUNCTION is used to recieve more toots. -JSON is the data returned from the server." - (with-output-to-temp-buffer buffer - (switch-to-buffer buffer) - ;; mastodon-mode wipes buffer-spec, so order must unforch be: - ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. - ;; which means we cannot use buffer-spec for update-function - ;; unless we set it both before and after the others - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function)) - (setq - ;; Initialize with a minimal interval; we re-scan at least once - ;; every 5 minutes to catch any timestamps we may have missed - mastodon-tl--timestamp-next-update (time-add (current-time) - (seconds-to-time 300))) - (funcall update-function json)) - (mastodon-mode) - (with-current-buffer buffer - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function) - mastodon-tl--timestamp-update-timer - (when mastodon-tl--enable-relative-timestamps - (run-at-time (time-to-seconds - (time-subtract mastodon-tl--timestamp-next-update - (current-time))) - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil))) - (unless (string-prefix-p "accounts" endpoint) - ;; for everything save profiles - (mastodon-tl--goto-first-item)))) -;;(or (equal endpoint "notifications") -;; (string-prefix-p "timelines" endpoint) -;; (string-prefix-p "favourites" endpoint) -;; (string-prefix-p "statuses" endpoint)) +RESPONSE is the data returned from the server by +`mastodon-http--process-json', a cons cell of JSON and http +headers." + (let* ((json (if headers (car response) response)) + (headers (if headers (cdr response) nil)) + (link-header (mastodon-tl--get-link-header-from-response headers))) + (with-output-to-temp-buffer buffer + (switch-to-buffer buffer) + ;; mastodon-mode wipes buffer-spec, so order must unforch be: + ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. + ;; which means we cannot use buffer-spec for update-function + ;; unless we set it both before and after the others + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq + ;; Initialize with a minimal interval; we re-scan at least once + ;; every 5 minutes to catch any timestamps we may have missed + mastodon-tl--timestamp-next-update (time-add (current-time) + (seconds-to-time 300))) + (funcall update-function json)) + (mastodon-mode) + (with-current-buffer buffer + (mastodon-tl--set-buffer-spec buffer + endpoint + update-function + link-header) + (setq mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time (time-to-seconds + (time-subtract mastodon-tl--timestamp-next-update + (current-time))) + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil))) + (unless (string-prefix-p "accounts" endpoint) + ;; for everything save profiles + (mastodon-tl--goto-first-item))))) (defun mastodon-tl--init-sync (buffer-name endpoint update-function) "Initialize BUFFER-NAME with timeline targeted by ENDPOINT. @@ -1993,10 +2118,7 @@ Runs synchronously." ;; 1 run update-function, 2 enable masto-mode, 3 set buffer spec. ;; which means we cannot use buffer-spec for update-function ;; unless we set it both before and after the others - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer - endpoint ,endpoint - update-function ,update-function)) + (mastodon-tl--set-buffer-spec buffer endpoint update-function) (setq ;; Initialize with a minimal interval; we re-scan at least once ;; every 5 minutes to catch any timestamps we may have missed @@ -2005,11 +2127,8 @@ Runs synchronously." (funcall update-function json)) (mastodon-mode) (with-current-buffer buffer - (setq mastodon-tl--buffer-spec - `(buffer-name ,buffer-name - endpoint ,endpoint update-function - ,update-function) - mastodon-tl--timestamp-update-timer + (mastodon-tl--set-buffer-spec buffer endpoint update-function) + (setq mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps (run-at-time (time-to-seconds (time-subtract mastodon-tl--timestamp-next-update diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7a40354..95eac31 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -78,6 +78,7 @@ (autoload 'mastodon-profile--update-preference "mastodon-profile") (autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") +(autoload 'mastodon-profile-fetch-server-account-settings-maybe "mastodon-profile") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -168,6 +169,11 @@ change the setting on the server, see (defvar-local mastodon-toot--reply-to-id nil "Buffer-local variable to hold the id of the toot being replied to.") + +(defvar-local mastodon-toot-previous-window-config nil + "A list of window configuration prior to composing a toot. +Takes its form from `window-configuration-to-register'.") + (defvar mastodon-toot--max-toot-chars nil "The maximum allowed characters count for a single toot.") @@ -203,12 +209,12 @@ send.") nil t))) (mastodon-profile--update-preference "privacy" vis :source))) -(defun mastodon-toot--get-max-toot-chars (&optional _no-toot) +(defun mastodon-toot--get-max-toot-chars (&optional no-toot) "Fetch max_toot_chars from `mastodon-instance-url' asynchronously. NO-TOOT means we are not calling from a toot buffer." (mastodon-http--get-json-async (mastodon-http--api "instance") - 'mastodon-toot--get-max-toot-chars-callback 'no-toot)) + 'mastodon-toot--get-max-toot-chars-callback no-toot)) (defun mastodon-toot--get-max-toot-chars-callback (json-response &optional no-toot) @@ -288,9 +294,13 @@ TYPE is a symbol, either 'favourite or 'boost." (cond ;; actually there's nothing wrong with faving/boosting own toots! ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json)) ;;(error "You can't %s your own toots" action-string)) - ((equal "reblog" toot-type) + ;; & nothing wrong with faving/boosting own toots from notifs: + ;; this boosts/faves the base toot, not the notif status + ((and (equal "reblog" toot-type) + (not (string= (mastodon-tl--get-endpoint) "notifications"))) (error "You can't %s boosts" action-string)) - ((equal "favourite" toot-type) + ((and (equal "favourite" toot-type) + (not (string= (mastodon-tl--get-endpoint) "notifications"))) (error "Your can't %s favourites" action-string)) (t (mastodon-toot--action @@ -473,13 +483,15 @@ REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." (defun mastodon-toot--kill (&optional cancel) "Kill `mastodon-toot-mode' buffer and window. CANCEL means the toot was not sent, so we save the toot text as a draft." - (unless (eq mastodon-toot-current-toot-text nil) - (when cancel - (cl-pushnew mastodon-toot-current-toot-text - mastodon-toot-draft-toots-list :test 'equal))) - ;; prevent some weird bug when cancelling a non-empty toot: - (delete #'mastodon-toot--save-toot-text after-change-functions) - (kill-buffer-and-window)) + (let ((prev-window-config mastodon-toot-previous-window-config)) + (unless (eq mastodon-toot-current-toot-text nil) + (when cancel + (cl-pushnew mastodon-toot-current-toot-text + mastodon-toot-draft-toots-list :test 'equal))) + ;; prevent some weird bug when cancelling a non-empty toot: + (delete #'mastodon-toot--save-toot-text after-change-functions) + (kill-buffer-and-window) + (mastodon-toot--restore-previous-window-config prev-window-config))) (defun mastodon-toot--cancel () "Kill new-toot buffer/window. Does not POST content to Mastodon. @@ -502,11 +514,12 @@ Pushes `mastodon-toot-current-toot-text' to (message "Draft saved!"))) (defun mastodon-toot-empty-p (&optional text-only) - "Return t if no text or attachments have been added to the compose buffer. + "Return t if no text, attachments, or polls have been added to the compose buffer. TEXT-ONLY means don't check for attachments." (and (if text-only t - (not mastodon-toot--media-attachments)) + (not mastodon-toot--media-attachments) + (not mastodon-toot-poll)) (string-empty-p (mastodon-tl--clean-tabs-and-nl (mastodon-toot--remove-docs))))) @@ -635,7 +648,8 @@ If media items have been attached and uploaded with (append args-media args-no-media) (if mastodon-toot-poll (append args-no-media args-poll) - args-no-media)))) + args-no-media))) + (prev-window-config mastodon-toot-previous-window-config)) (cond ((and mastodon-toot--media-attachments ;; make sure we have media args ;; and the same num of ids as attachments @@ -653,7 +667,14 @@ If media items have been attached and uploaded with (mastodon-http--triage response (lambda () (mastodon-toot--kill) - (message "Toot toot!")))))))) + (message "Toot toot!") + (mastodon-toot--restore-previous-window-config prev-window-config)))))))) + +(defun mastodon-toot--restore-previous-window-config (config) + "Restore the window CONFIG after killing the toot compose buffer. +Buffer-local variable `mastodon-toot-previous-window-config' holds the config." + (set-window-configuration (car config)) + (goto-char (cadr config))) (defun mastodon-toot--process-local (acct) "Add domain to local ACCT and replace the curent user name with \"\". @@ -946,11 +967,29 @@ which is used to attach it to a toot when posting." (cl-loop for o in options collect `(,key . ,o)))) +(defun mastodon-toot--fetch-max-poll-options () + "Return the maximum number of poll options from the user's instance. " + (let* ((instance (mastodon-http--get-json (mastodon-http--api "instance")))) + (alist-get 'max_options + (alist-get 'polls + (alist-get 'configuration instance) + instance)))) + +(defun mastodon-toot--read-poll-options-count (max) + "Read the user's choice of the number of options the poll should have. +MAX is the maximum number set by their instance." + (let ((number (read-number + (format "Number of options [2-%s]: " max) 2))) + (if (> number max) + (error "You need to choose a number between 2 and %s" max) + number))) + (defun mastodon-toot--create-poll () "Prompt for new poll options and return as a list." (interactive) ;; re length, API docs show a poll 9 options. - (let* ((length (read-number "Number of options [2-4]: " 2)) + (let* ((max-options (mastodon-toot--fetch-max-poll-options)) + (length (mastodon-toot--read-poll-options-count max-options)) (multiple-p (y-or-n-p "Multiple choice? ")) (options (mastodon-toot--read-poll-options length)) (hide-totals (y-or-n-p "Hide votes until poll ends? ")) @@ -1247,7 +1286,9 @@ a draft into the buffer." (let* ((buffer-exists (get-buffer "*new toot*")) (buffer (or buffer-exists (get-buffer-create "*new toot*"))) (inhibit-read-only t) - (reply-text (alist-get 'content reply-json))) + (reply-text (alist-get 'content reply-json)) + (previous-window-config (list (current-window-configuration) + (point-marker)))) (switch-to-buffer-other-window buffer) (text-mode) (mastodon-toot-mode t) @@ -1280,11 +1321,13 @@ a draft into the buffer." (setq mastodon-toot-current-toot-text nil) (push #'mastodon-toot--save-toot-text after-change-functions) (push #'mastodon-toot--propertize-tags-and-handles after-change-functions) + ;; if we set this before changing modes, it gets nuked: + (setq mastodon-toot-previous-window-config previous-window-config) (when initial-text (insert initial-text)))) ;;;###autoload -(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings) +(add-hook 'mastodon-toot-mode-hook #'mastodon-profile-fetch-server-account-settings-maybe) (define-minor-mode mastodon-toot-mode "Minor mode to capture Mastodon toots." diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 671c88d..b169f00 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -325,7 +325,8 @@ not, just browse the URL in the normal fashion." (string-match "^/display/[-a-f0-9]+$" query) (string-match "^/profile/[[:alpha:]]+$" query) (string-match "^/p/[[:alpha:]]+/[[:digit:]]+$" query) - (string-match "^/[[:alpha:]]+$" query))))) + (string-match "^/[[:alpha:]]+$" query) + (string-match "^/u/[[:alpha:]]+$" query))))) ;;;###autoload (add-hook 'mastodon-mode-hook (lambda () diff --git a/test/mastodon-profile-tests.el b/test/mastodon-profile-tests.el index 640afb7..267e48b 100644 --- a/test/mastodon-profile-tests.el +++ b/test/mastodon-profile-tests.el @@ -240,7 +240,7 @@ content generation in the function under test." []) (mock (mastodon-profile--relationships-get "1") => - [((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . ""))]) + '(((id . "1") (following . :json-false) (showing_reblogs . :json-false) (notifying . :json-false) (followed_by . :json-false) (blocking . :json-false) (blocked_by . :json-false) (muting . :json-false) (muting_notifications . :json-false) (requested . :json-false) (domain_blocking . :json-false) (endorsed . :json-false) (note . "")))) ;; Let's not do formatting as that makes it hard to not rely on ;; window width and reflowing the text. (mock (shr-render-region * *) => nil) @@ -259,7 +259,7 @@ content generation in the function under test." (buffer-substring-no-properties (point-min) (point-max)) (concat "\n" - "[img] \n" + "[img] [img] \n" "Eugen\n" "@Gargron\n" " ------------\n" diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 5b95cdc..39e0984 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -92,10 +92,13 @@ mention string." ;; TODO: test y-or-no-p with mastodon-toot--cancel (ert-deftest mastodon-toot--kill () "Should kill the buffer when cancelling the toot." - (with-mock - (mock (kill-buffer-and-window)) - (mastodon-toot--kill) - (mock-verify))) + (let ((mastodon-toot-previous-window-config + (list (current-window-configuration) + (point-marker)))) + (with-mock + (mock (kill-buffer-and-window)) + (mastodon-toot--kill) + (mock-verify)))) (ert-deftest mastodon-toot--own-toot-p-fail () "Should not return t if not own toot." |