diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/mastodon-http.el | 73 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 90 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 306 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 32 | ||||
| -rw-r--r-- | lisp/mastodon.el | 3 |
5 files changed, 339 insertions, 165 deletions
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-profile.el b/lisp/mastodon-profile.el index 4aa9310..56e5fef 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -137,6 +137,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 +188,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." @@ -246,8 +252,8 @@ JSON is the data returned by the server." (defun mastodon-profile--update-user-profile-note () "Fetch user's profile note and display for editing." (interactive) - (let* ((url (mastodon-http--api "accounts/update_credentials")) - (json (mastodon-http--patch-json url)) + (let* ((url (mastodon-http--api "accounts/verify_credentials")) + (json (mastodon-http--get-json url)) (source (alist-get 'source json)) (note (alist-get 'note source)) (buffer (get-buffer-create "*mastodon-update-profile*")) @@ -270,7 +276,7 @@ JSON is the data returned by the server." (let* ((note (buffer-substring-no-properties (point-min) (point-max))) (url (mastodon-http--api "accounts/update_credentials"))) (kill-buffer-and-window) - (let ((response (mastodon-http--patch url `((note ,note))))) + (let ((response (mastodon-http--patch url `(("note" . ,note))))) (mastodon-http--triage response (lambda () (message "Profile note updated!")))))) @@ -296,30 +302,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 +480,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 +543,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 +570,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 +636,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 a8c466d..3f5dd04 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) @@ -656,10 +657,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 +678,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 +703,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 +823,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 +835,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 +1009,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 +1021,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) @@ -996,7 +1030,12 @@ this just means displaying toot client." ((> (plist-get parsed :hours) 0) (format "%s hours, %s minutes left" (plist-get parsed :hours) (plist-get parsed :minutes))) ((> (plist-get parsed :minutes) 0) - (format "%s minutes left" (plist-get parsed :minutes)))))) + (format "%s minutes left" (plist-get parsed :minutes))) + (t ;; we failed to guess: + (format "%s days, %s hours, %s minutes left" + (plist-get parsed :days) + (plist-get parsed :hours) + (plist-get parsed :minutes)))))) (defun mastodon-tl--poll-vote (option) "If there is a poll at point, prompt user for OPTION to vote on it." @@ -1123,7 +1162,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'." @@ -1132,6 +1176,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 @@ -1232,11 +1289,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)))))) @@ -1273,11 +1328,10 @@ 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/context" id) - update-function - (lambda (toot) (message "END of thread.")))) + (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)) @@ -1450,7 +1504,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 @@ -1652,11 +1708,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)))))) @@ -1696,9 +1758,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) @@ -1755,23 +1821,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) @@ -1932,58 +2023,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. @@ -1999,10 +2099,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 @@ -2011,11 +2108,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 99c202e..e203cda 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") @@ -208,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) @@ -509,11 +510,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))))) @@ -961,11 +963,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? ")) @@ -1303,7 +1323,7 @@ a draft into the buffer." (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 3b0a7d0..da2d442 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -324,7 +324,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 () |