aboutsummaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/mastodon-auth.el1
-rw-r--r--lisp/mastodon-tl.el174
-rw-r--r--lisp/mastodon-toot.el88
3 files changed, 163 insertions, 100 deletions
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el
index 263ece2..3de2901 100644
--- a/lisp/mastodon-auth.el
+++ b/lisp/mastodon-auth.el
@@ -137,6 +137,7 @@ When ASK is absent return nil."
(let ((url (mastodon-auth--get-browser-login-url))
authorization-code)
(kill-new url)
+ (message "%s" url)
(setq authorization-code
(mastodon-auth--show-notice mastodon-auth--explanation
"*mastodon-notice*"
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index e732420..b3427fc 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -149,11 +149,24 @@ font settings do not support it."
:type '(alist :key-type symbol :value-type string)
:group 'mastodon-tl)
+(defcustom mastodon-tl-position-after-update nil
+ "Defines where `point' should be located after a timeline update.
+Valid values are:
+- nil Top/bottom depending on timeline type
+- keep-point Keep original position of point
+- last-old-toot The last toot before the new ones"
+ :type '(choice (const :tag "Top/bottom depending on timeline type" nil)
+ (const :tag "Keep original position of point" keep-point)
+ (const :tag "The last toot before the new ones" last-old-toot)))
+
(defvar-local mastodon-tl--update-point nil
"When updating a mastodon buffer this is where new toots will be inserted.
If nil `(point-min)' is used instead.")
+(defvar-local mastodon-tl--after-update-marker nil
+ "Marker defining the position of point after the update is done.")
+
(defvar mastodon-tl--display-media-p t
"A boolean value stating whether to show media in timelines.")
@@ -404,7 +417,8 @@ Used on initializing a timeline or thread."
(interactive)
(message "Loading local timeline...")
(mastodon-tl--init
- "local" "timelines/public?local=true" 'mastodon-tl--timeline))
+ "local" "timelines/public" 'mastodon-tl--timeline
+ nil '(("local" . "true"))))
(defun mastodon-tl--get-tag-timeline ()
"Prompt for tag and opens its timeline."
@@ -1044,8 +1058,12 @@ message is a link which unhides/hides the main body."
'invisible
;; check server setting to expand all spoilers:
(unless (eq t
- (mastodon-profile--get-preferences-pref
- 'reading:expand:spoilers))
+ ;; If something goes wrong reading prefs,
+ ;; just return nil so CWs show by default.
+ (condition-case nil
+ (mastodon-profile--get-preferences-pref
+ 'reading:expand:spoilers)
+ (error nil)))
t)
'mastodon-content-warning-body t))))
@@ -1400,18 +1418,21 @@ LINK-HEADER is the http Link header if present."
(url (mastodon-http--api endpoint)))
(mastodon-http--get-json url args)))
-(defun mastodon-tl--more-json-async (endpoint id callback &rest cbargs)
+(defun mastodon-tl--more-json-async (endpoint id &optional params callback &rest cbargs)
"Return JSON for timeline ENDPOINT before ID.
-Then run CALLBACK with arguments CBARGS."
+Then run CALLBACK with arguments CBARGS
+PARAMS is used to send 'local=true' for local timeline."
(let* ((args `(("max_id" . ,(mastodon-tl--as-string id))))
+ (args (if params (push params args) args))
(url (mastodon-http--api endpoint)))
(apply 'mastodon-http--get-json-async url args callback cbargs)))
;; TODO
;; Look into the JSON returned here by Local
-(defun mastodon-tl--updated-json (endpoint id)
+(defun mastodon-tl--updated-json (endpoint id &optional params)
"Return JSON for timeline ENDPOINT since ID."
(let* ((args `(("since_id" . ,(mastodon-tl--as-string id))))
+ (args (if params (push params args) args))
(url (mastodon-http--api endpoint)))
(mastodon-http--get-json url args)))
@@ -1514,7 +1535,7 @@ ID is that of the toot to view."
(mastodon-mode)
(mastodon-tl--set-buffer-spec buffer
endpoint
- nil)
+ #'mastodon-tl--thread)
(let ((inhibit-read-only t))
(mastodon-tl--timeline (alist-get 'ancestors context))
(goto-char (point-max))
@@ -2536,7 +2557,7 @@ For use after e.g. deleting a toot."
(mastodon-tl--get-home-timeline))
((equal (mastodon-tl--get-endpoint) "timelines/public")
(mastodon-tl--get-federated-timeline))
- ((equal (mastodon-tl--get-endpoint) "timelines/public?local=true")
+ ((equal (mastodon-tl--buffer-name) "*mastodon-local*")
(mastodon-tl--get-local-timeline))
((equal (mastodon-tl--get-endpoint) "notifications")
(mastodon-notifications-get))
@@ -2579,8 +2600,13 @@ when showing followers or accounts followed."
(url (mastodon-tl--build-link-header-url next)))
(mastodon-http--get-response-async url nil '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))))
+ (mastodon-tl--more-json-async
+ (mastodon-tl--get-endpoint)
+ (mastodon-tl--oldest-id)
+ ;; local has same endpoint as federated:
+ (when (string= (mastodon-tl--buffer-name) "*mastodon-local*")
+ '("local" . "true"))
+ 'mastodon-tl--more* (current-buffer) (point))))
(defun mastodon-tl--more* (response buffer point-before &optional headers)
"Append older toots to timeline, asynchronously.
@@ -2751,36 +2777,66 @@ from the start if it is nil."
#'mastodon-tl--update-timestamps-callback
buffer nil))))))))
+(defun mastodon-tl--set-after-update-marker ()
+ (if mastodon-tl-position-after-update
+ (let ((marker (make-marker)))
+ (set-marker marker
+ (cond
+ ((eq 'keep-point mastodon-tl-position-after-update)
+ (point))
+ ((eq 'last-old-toot mastodon-tl-position-after-update)
+ (next-single-property-change
+ (or mastodon-tl--update-point (point-min))
+ 'byline))
+ (error "Unknown mastodon-tl-position-after-update value %S"
+ mastodon-tl-position-after-update)))
+ ;; Make the marker advance if text gets inserted there.
+ (set-marker-insertion-type marker t)
+ (setq mastodon-tl--after-update-marker marker))
+ (setq mastodon-tl--after-update-marker nil)))
+
(defun mastodon-tl--update ()
"Update timeline with new toots."
(interactive)
(let* ((endpoint (mastodon-tl--get-endpoint))
(update-function (mastodon-tl--get-update-function))
- (id (mastodon-tl--newest-id))
- (json (mastodon-tl--updated-json endpoint id)))
- (if json
- (let ((inhibit-read-only t))
- (goto-char (or mastodon-tl--update-point (point-min)))
- (funcall update-function json))
- (message "nothing to update"))))
+ (thread-id (mastodon-tl--property 'toot-id)))
+ ;; update a thread, without calling `mastodon-tl--updated-json':
+ (if (string-suffix-p "context" (mastodon-tl--get-endpoint))
+ (funcall update-function thread-id)
+ ;; update other timelines:
+ (let* ((id (mastodon-tl--newest-id))
+ (params (when (string= (mastodon-tl--buffer-name) "*mastodon-local*")
+ '("local" . "true")))
+ (json (mastodon-tl--updated-json endpoint id params)))
+ (if json
+ (let ((inhibit-read-only t))
+ (mastodon-tl--set-after-update-marker)
+ (goto-char (or mastodon-tl--update-point (point-min)))
+ (funcall update-function json)
+ (when mastodon-tl--after-update-marker
+ (goto-char mastodon-tl--after-update-marker))))
+ (message "nothing to update")))))
(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) ", ")))
-(defun mastodon-tl--init (buffer-name endpoint update-function &optional headers)
+(defun mastodon-tl--init (buffer-name endpoint update-function &optional headers params)
"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 and bookmarks."
+favourites and bookmarks.
+PARAMS is any parameters to send with the request, currently only
+used to send 'local=true' for local timeline."
(let ((url (mastodon-http--api endpoint))
(buffer (concat "*mastodon-" buffer-name "*")))
(if headers
(mastodon-http--get-response-async
- url nil 'mastodon-tl--init* buffer endpoint update-function headers)
+ url params 'mastodon-tl--init* buffer endpoint update-function headers)
(mastodon-http--get-json-async
- url nil 'mastodon-tl--init* buffer endpoint update-function))))
+ url params 'mastodon-tl--init* buffer endpoint update-function))))
(defun mastodon-tl--init* (response buffer endpoint update-function &optional headers)
"Initialize BUFFER with timeline targeted by ENDPOINT.
@@ -2788,43 +2844,45 @@ UPDATE-FUNCTION is used to recieve more toots.
RESPONSE is the data returned from the server by
`mastodon-http--process-json', with arg HEADERS a cons cell of
JSON and http headers, without it just the JSON."
- (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)))))
+ (let ((json (if headers (car response) response)))
+ (if (not json) ; praying this is right here, else try "\n[]"
+ (message "Looks like nothing returned from endpoint: %s" endpoint)
+ (let* ((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 &optional note-type)
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 7ca9fce..cbcc4f3 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -703,6 +703,8 @@ instance to edit a toot."
(interactive)
(let* ((edit-p (if mastodon-toot--edit-toot-id t nil))
(toot (mastodon-toot--remove-docs))
+ (scheduled mastodon-toot--scheduled-for)
+ (scheduled-id mastodon-toot--scheduled-id)
(endpoint
(if edit-p
;; we are sending an edit:
@@ -713,14 +715,16 @@ instance to edit a toot."
mastodon-toot--content-warning)
(read-string "Warning: "
mastodon-toot--content-warning-from-reply-or-redraft)))
- (args-no-media `(("status" . ,toot)
- ("in_reply_to_id" . ,mastodon-toot--reply-to-id)
- ("visibility" . ,mastodon-toot--visibility)
- ("sensitive" . ,(when mastodon-toot--content-nsfw
- (symbol-name t)))
- ("spoiler_text" . ,spoiler)
- ("language" . ,mastodon-toot--language)
- ("scheduled_at" . ,mastodon-toot--scheduled-for)))
+ (args-no-media (append `(("status" . ,toot)
+ ("in_reply_to_id" . ,mastodon-toot--reply-to-id)
+ ("visibility" . ,mastodon-toot--visibility)
+ ("sensitive" . ,(when mastodon-toot--content-nsfw
+ (symbol-name t)))
+ ("spoiler_text" . ,spoiler)
+ ("language" . ,mastodon-toot--language))
+ ; Pleroma instances can't handle null-valued
+ ; scheduled_at args, so only add if non-nil
+ (when scheduled `(("scheduled_at" . ,scheduled)))))
(args-media (when mastodon-toot--media-attachments
(mastodon-http--build-array-params-alist
"media_ids[]"
@@ -733,9 +737,7 @@ instance to edit a toot."
(if mastodon-toot-poll
(append args-no-media args-poll)
args-no-media)))
- (prev-window-config mastodon-toot-previous-window-config)
- (scheduled mastodon-toot--scheduled-for)
- (scheduled-id mastodon-toot--scheduled-id))
+ (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
@@ -744,7 +746,7 @@ instance to edit a toot."
(length mastodon-toot--media-attachment-ids)))))
(message "Something is wrong with your uploads. Wait for them to complete or try again."))
((and mastodon-toot--max-toot-chars
- (> (length toot) mastodon-toot--max-toot-chars))
+ (> (mastodon-toot--count-toot-chars toot) mastodon-toot--max-toot-chars))
(message "Looks like your toot is longer than that maximum allowed length."))
((mastodon-toot--empty-p)
(message "Empty toot. Cowardly refusing to post this."))
@@ -841,32 +843,41 @@ Buffer-local variable `mastodon-toot-previous-window-config' holds the config."
(set-window-configuration (car config))
(goto-char (cadr config)))
+(defun mastodon-toot--mentions-to-string (mentions)
+ "Applies mastodon-toot--process-local function to each mention,
+removes empty string (self) from result and joins the sequence with whitespace \" \"."
+ (mapconcat (lambda(mention) mention)
+ (remove "" (mapcar (lambda(x) (mastodon-toot--process-local x))
+ mentions))
+ " "))
+
(defun mastodon-toot--process-local (acct)
"Add domain to local ACCT and replace the curent user name with \"\".
-Mastodon requires the full user@domain, even in the case of local accts.
-eg. \"user\" -> \"user@local.social \" (when local.social is the domain of the
+Mastodon requires the full @user@domain, even in the case of local accts.
+eg. \"user\" -> \"@user@local.social\" (when local.social is the domain of the
mastodon-instance-url).
eg. \"yourusername\" -> \"\"
-eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
- (cond ((string-match-p "@" acct) (concat "@" acct " ")) ; federated acct
+eg. \"feduser@fed.social\" -> \"@feduser@fed.social\"."
+ (cond ((string-match-p "@" acct) (concat "@" acct)) ; federated acct
((string= (mastodon-auth--user-acct) acct) "") ; your acct
(t (concat "@" acct "@" ; local acct
- (cadr (split-string mastodon-instance-url "/" t)) " "))))
+ (cadr (split-string mastodon-instance-url "/" t))))))
(defun mastodon-toot--mentions (status)
- "Extract mentions from STATUS and process them into a string."
+ "Extract mentions (not the reply-to author or booster) from STATUS.
+The mentioned users look like this:
+Local user (including the logged in): `username`.
+Federated user: `username@host.co`."
(interactive)
(let* ((boosted (mastodon-tl--field 'reblog status))
(mentions
(if boosted
- (alist-get 'mentions (alist-get 'reblog status))
- (alist-get 'mentions status))))
- (mapconcat (lambda(x) (mastodon-toot--process-local
- (alist-get 'acct x)))
- ;; reverse does not work on vectors in 24.5
- (reverse (append mentions nil))
- "")))
+ (alist-get 'mentions (alist-get 'reblog status))
+ (alist-get 'mentions status))))
+ ;; reverse does not work on vectors in 24.5
+ (mapcar (lambda(x) (alist-get 'acct x))
+ (reverse mentions))))
(defun mastodon-toot--get-bounds (regex)
"Get bounds of tag or handle before point using REGEX."
@@ -887,10 +898,8 @@ eg. \"feduser@fed.social\" -> \"feduser@fed.social\"."
"Search for a completion prefix from buffer positions START to END.
Return a list of candidates.
If TAGS, we search for tags, else we search for handles."
- ;; FIXME: can we save the first two-letter search then only filter the
- ;; resulting list?
- ;; (or mastodon-toot-completions
- ;; would work if we could null that var upon completion success
+ ;; we can't save the first two-letter search then only filter the
+ ;; resulting list, as max results returned is 40.
(setq mastodon-toot-completions
(if tags
(let ((tags-list (mastodon-search--search-tags-query
@@ -970,26 +979,21 @@ text of the toot being replied to in the compose buffer."
(mastodon-toot (when user
(if booster
(if (and (not (equal user booster))
- (not (string-match booster mentions)))
+ (not (member booster mentions)))
;; different booster, user and mentions:
- (concat (mastodon-toot--process-local user)
- ;; "@" booster " "
- (mastodon-toot--process-local booster)
- mentions)
+ (mastodon-toot--mentions-to-string (append (list user booster) mentions nil))
;; booster is either user or in mentions:
- (if (not (string-match user mentions))
+ (if (not (member user mentions))
;; user not already in mentions:
- (concat (mastodon-toot--process-local user)
- mentions)
+ (mastodon-toot--mentions-to-string (append (list user) mentions nil))
;; user already in mentions:
- mentions))
+ (mastodon-toot--mentions-to-string (copy-sequence mentions))))
;; ELSE no booster:
- (if (not (string-match user mentions))
+ (if (not (member user mentions))
;; user not in mentions:
- (concat (mastodon-toot--process-local user)
- mentions)
+ (mastodon-toot--mentions-to-string (append (list user) mentions nil))
;; user in mentions already:
- mentions)))
+ (mastodon-toot--mentions-to-string (copy-sequence mentions)))))
id
(or base-toot toot))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 15:11:55 +0000