aboutsummaryrefslogtreecommitdiff
path: root/lisp/mastodon-tl.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mastodon-tl.el')
-rw-r--r--lisp/mastodon-tl.el581
1 files changed, 513 insertions, 68 deletions
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 66452dd..252cefd 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2017 Johnson Denen
;; Author: Johnson Denen <johnson.denen@gmail.com>
-;; Version: 0.7.1
+;; Version: 0.7.2
;; Homepage: https://github.com/jdenen/mastodon.el
;; Package-Requires: ((emacs "24.4"))
@@ -40,19 +40,130 @@
(autoload 'mastodon-media--inline-images "mastodon-media")
(autoload 'mastodon-mode "mastodon")
(defvar mastodon-toot-timestamp-format)
+(defvar shr-use-fonts) ;; need to declare it since Emacs24 didn't have this
(defgroup mastodon-tl nil
"Timelines in Mastodon."
:prefix "mastodon-tl-"
:group 'mastodon)
+(defcustom mastodon-tl--enable-relative-timestamps t
+ "Nonnil to enable showing relative (to the current time) timestamps.
+
+This will require periodic updates of a timeline buffer to
+keep the timestamps current as time progresses."
+ :group 'mastodon-tl
+ :type '(boolean :tag "Enable relative timestamps and background updater task"))
+
+(defcustom mastodon-tl--enable-proportional-fonts nil
+ "Nonnil to enable using proportional fonts when rendering HTML.
+
+By default fixed width fonts are used."
+ :group 'mastodon-tl
+ :type '(boolean :tag "Enable using proportional rather than fixed \
+width fonts when rendering HTML text"))
+
(defvar mastodon-tl--buffer-spec nil
"A unique identifier and functions for each Mastodon buffer.")
+(make-variable-buffer-local 'mastodon-tl--buffer-spec)
(defvar mastodon-tl--show-avatars-p
(image-type-available-p 'imagemagick)
"A boolean value stating whether to show avatars in timelines.")
+(defvar mastodon-tl--display-media-p t
+ "A boolean value stating whether to show media in timelines.")
+
+(defvar mastodon-tl--timestamp-next-update nil
+ "The timestamp when the buffer should next be scanned to update the timestamps.")
+(make-variable-buffer-local 'mastodon-tl--timestamp-next-update)
+
+(defvar mastodon-tl--timestamp-update-timer nil
+ "The timer that, when set will scan the buffer to update the timestamps.")
+(make-variable-buffer-local 'mastodon-tl--timestamp-update-timer)
+
+(defvar mastodon-tl--link-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [return] 'mastodon-tl--do-link-action-at-point)
+ (define-key map [mouse-2] 'mastodon-tl--do-link-action)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [tab] 'mastodon-tl--next-tab-item)
+ (define-key map [M-tab] 'mastodon-tl--previous-tab-item)
+ (define-key map [S-tab] 'mastodon-tl--previous-tab-item)
+ (define-key map [backtab] 'mastodon-tl--previous-tab-item)
+ (keymap-canonicalize map))
+ "The keymap set for things in the buffer that act like links (except for shr.el generate links).
+
+This will make the region of text act like like a link with mouse
+highlighting, mouse click action tabbing to next/previous link
+etc.")
+
+(defvar mastodon-tl--shr-map-replacement
+ (let ((map (copy-keymap shr-map)))
+ ;; Replace the move to next/previous link bindings with our
+ ;; version that knows about more types of links.
+ (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item)
+ (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item)
+ (keymap-canonicalize map))
+ "The keymap to be set for shr.el generated links that are not images.
+
+We need to override the keymap so tabbing will navigate to all
+types of mastodon links and not just shr.el-generated ones.")
+
+(defvar mastodon-tl--shr-image-map-replacement
+ (let ((map (copy-keymap (if (boundp 'shr-image-map)
+ shr-image-map
+ shr-map))))
+ ;; Replace the move to next/previous link bindings with our
+ ;; version that knows about more types of links.
+ (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item)
+ (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item)
+ (keymap-canonicalize map))
+ "The keymap to be set for shr.el generated image links.
+
+We need to override the keymap so tabbing will navigate to all
+types of mastodon links and not just shr.el-generated ones.")
+
+(defun mastodon-tl--next-tab-item ()
+ "Move to the next interesting item.
+
+This could be the next toot, link, or image; whichever comes first.
+Don't move if nothing else to move to is found, i.e. near the end of the buffer.
+This also skips tab items in invisible text, i.e. hidden spoiler text."
+ (interactive)
+ (let (next-range
+ (search-pos (point)))
+ (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range
+ 'mastodon-tab-stop search-pos nil))
+
+ (get-text-property (car next-range) 'invisible)
+ (setq search-pos (1+ (cdr next-range))))
+ ;; do nothing, all the action in in the while condition
+ )
+ (if (null next-range)
+ (message "Nothing else here.")
+ (goto-char (car next-range))
+ (message "%s" (get-text-property (point) 'help-echo)))))
+
+(defun mastodon-tl--previous-tab-item ()
+ "Move to the previous interesting item.
+
+This could be the previous toot, link, or image; whichever comes first.
+Don't move if nothing else to move to is found, i.e. near the start of the buffer.
+This also skips tab items in invisible text, i.e. hidden spoiler text."
+ (interactive)
+ (let (next-range
+ (search-pos (point)))
+ (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range
+ 'mastodon-tab-stop search-pos t))
+ (get-text-property (car next-range) 'invisible)
+ (setq search-pos (1- (car next-range))))
+ ;; do nothing, all the action in in the while condition
+ )
+ (if (null next-range)
+ (message "Nothing else before this.")
+ (goto-char (car next-range))
+ (message "%s" (get-text-property (point) 'help-echo)))))
(defun mastodon-tl--get-federated-timeline ()
"Opens federated timeline."
@@ -120,8 +231,10 @@ Optionally start from POS."
(handle (cdr (assoc 'acct account)))
(name (cdr (assoc 'display_name account)))
(avatar-url (cdr (assoc 'avatar account))))
+ ;; TODO: Once we have a view for a user (e.g. their posts
+ ;; timeline) make this a tab-stop and attach an action
(concat
- (when mastodon-tl--show-avatars-p
+ (when (and mastodon-tl--show-avatars-p mastodon-tl--display-media-p)
(mastodon-media--get-avatar-rendering avatar-url))
(propertize name 'face 'mastodon-display-name-face)
(propertize (concat " (@"
@@ -146,54 +259,204 @@ Return value from boosted content if available."
(or (cdr (assoc field (cdr (assoc 'reblog toot))))
(cdr (assoc field toot))))
+(defun mastodon-tl--relative-time-details (timestamp &optional current-time)
+ "Returns cons of (descriptive string . next change) for the TIMESTAMP.
+
+Use the optional CURRENT-TIME as the current time (only used for
+reliable testing).
+
+The descriptive string is a human readable version relative to
+the current time while the next change timestamp give the first
+time that this description will change in the future.
+
+TIMESTAMP is assumed to be in the past."
+ (let* ((now (or current-time (current-time)))
+ (time-difference (time-subtract now timestamp))
+ (seconds-difference (float-time time-difference))
+ (regular-response
+ (lambda (seconds-difference multiplier unit-name)
+ (let ((n (floor (+ 0.5 (/ seconds-difference multiplier)))))
+ (cons (format "%d %ss ago" n unit-name)
+ (* (+ 0.5 n) multiplier)))))
+ (relative-result
+ (cond
+ ((< seconds-difference 60)
+ (cons "less than a minute ago"
+ 60))
+ ((< seconds-difference (* 1.5 60))
+ (cons "one minute ago"
+ 90)) ;; at 90 secs
+ ((< seconds-difference (* 60 59.5))
+ (funcall regular-response seconds-difference 60 "minute"))
+ ((< seconds-difference (* 1.5 60 60))
+ (cons "one hour ago"
+ (* 60 90))) ;; at 90 minutes
+ ((< seconds-difference (* 60 60 23.5))
+ (funcall regular-response seconds-difference (* 60 60) "hour"))
+ ((< seconds-difference (* 1.5 60 60 24))
+ (cons "one day ago"
+ (* 1.5 60 60 24))) ;; at a day and a half
+ ((< seconds-difference (* 60 60 24 6.5))
+ (funcall regular-response seconds-difference (* 60 60 24) "day"))
+ ((< seconds-difference (* 1.5 60 60 24 7))
+ (cons "one week ago"
+ (* 1.5 60 60 24 7))) ;; a week and a half
+ ((< seconds-difference (* 60 60 24 7 52))
+ (if (= 52 (floor (+ 0.5 (/ seconds-difference 60 60 24 7))))
+ (cons "52 weeks ago"
+ (* 60 60 24 7 52))
+ (funcall regular-response seconds-difference (* 60 60 24 7) "week")))
+ ((< seconds-difference (* 1.5 60 60 24 365))
+ (cons "one year ago"
+ (* 60 60 24 365 1.5))) ;; a year and a half
+ (t
+ (funcall regular-response seconds-difference (* 60 60 24 365.25) "year")))))
+ (cons (car relative-result)
+ (time-add timestamp (seconds-to-time (cdr relative-result))))))
+
+(defun mastodon-tl--relative-time-description (timestamp &optional current-time)
+ "Returns a string with a human readable description of TIMESTMAP relative to the current time.
+
+Use the optional CURRENT-TIME as the current time (only used for
+reliable testing).
+
+E.g. this could return something like \"1 min ago\", \"yesterday\", etc.
+TIME-STAMP is assumed to be in the past."
+ (car (mastodon-tl--relative-time-details timestamp current-time)))
+
(defun mastodon-tl--byline (toot)
"Generate byline for TOOT."
(let ((id (cdr (assoc 'id toot)))
- (timestamp (mastodon-tl--field 'created_at toot))
- (faved (mastodon-tl--field 'favourited toot))
- (boosted (mastodon-tl--field 'reblogged toot)))
+ (parsed-time (date-to-time (mastodon-tl--field 'created_at toot)))
+ (faved (equal 't (mastodon-tl--field 'favourited toot)))
+ (boosted (equal 't (mastodon-tl--field 'reblogged toot))))
+ (concat
+ (propertize "\n | " 'face 'default)
+ (propertize
+ (concat (when boosted
+ (format "(%s) "
+ (propertize "B" 'face 'mastodon-boost-fave-face)))
+ (when faved
+ (format "(%s) "
+ (propertize "F" 'face 'mastodon-boost-fave-face)))
+ (mastodon-tl--byline-author toot)
+ (mastodon-tl--byline-boosted toot)
+ " "
+ ;; TODO: Once we have a view for toot (responses etc.) make
+ ;; this a tab stop and attach an action.
+ (propertize
+ (format-time-string mastodon-toot-timestamp-format parsed-time)
+ 'timestamp parsed-time
+ 'display (if mastodon-tl--enable-relative-timestamps
+ (mastodon-tl--relative-time-description parsed-time)
+ parsed-time))
+ (propertize "\n ------------" 'face 'default))
+ 'favourited-p faved
+ 'boosted-p boosted
+ 'toot-id id
+ 'toot-json toot))))
+
+(defun mastodon-tl--render-text (string)
+ "Returns a propertized text giving the rendering of the given HTML string."
+ (with-temp-buffer
+ (insert string)
+ (let ((shr-use-fonts mastodon-tl--enable-proportional-fonts)
+ (shr-width (when mastodon-tl--enable-proportional-fonts
+ (window-width))))
+ (shr-render-region (point-min) (point-max)))
+ ;; Make all links a tab stop recognized by our own logic and
+ ;; update keymaps where needed.
+ ;;
+ ;; TODO: Once we have views for users and tags we need to
+ ;; recognize these links and turn them into links to our own
+ ;; views.
+ (let (region)
+ (while (setq region (mastodon-tl--find-property-range
+ 'shr-url (or (cdr region) (point-min))))
+ (let* ((start (car region))
+ (end (cdr region))
+ (keymap (if (eq shr-map (get-text-property start 'keymap))
+ mastodon-tl--shr-map-replacement
+ mastodon-tl--shr-image-map-replacement)))
+ (add-text-properties start end
+ (list 'mastodon-tab-stop 'shr-url
+ 'keymap keymap)))))
+ (buffer-string)))
+
+(defun mastodon-tl--set-face (string face)
+ "Returns the propertized STRING with the face property set to FACE."
+ (propertize string 'face face))
+
+(defun mastodon-tl--toggle-spoiler-text (position)
+ "Toggle the visibility of the spoiler text at/after POSITION."
+ (let ((inhibit-read-only t)
+ (spoiler-text-region (mastodon-tl--find-property-range
+ 'mastodon-content-warning-body position nil)))
+ (if (not spoiler-text-region)
+ (message "No spoiler text here")
+ (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region)
+ (list 'invisible
+ (not (get-text-property (car spoiler-text-region)
+ 'invisible)))))))
+(defun mastodon-tl--make-link (string link-type)
+ "Return a propertized version of STRING that will act like link.
+
+LINK-TYPE is the type of link to produce."
+ (let ((help-text (cond
+ ((eq link-type 'content-warning)
+ "Toggle hidden text")
+ (t
+ (error "unknown link type %s" link-type)))))
(propertize
- (concat (propertize "\n | " 'face 'default)
- (when boosted
- (format "(%s) "
- (propertize "B" 'face 'mastodon-boost-fave-face)))
- (when faved
- (format "(%s) "
- (propertize "F" 'face 'mastodon-boost-fave-face)))
- (mastodon-tl--byline-author toot)
- (mastodon-tl--byline-boosted toot)
- " "
- (format-time-string mastodon-toot-timestamp-format (date-to-time timestamp))
- (propertize "\n ------------" 'face 'default))
- 'favourited-p faved
- 'boosted-p boosted
- 'toot-id id
- 'toot-json toot)))
-
-(defun mastodon-tl--set-face (string face render)
- "Set the face of a string. If `render' is not nil
-also render the html"
- (propertize
- (with-temp-buffer
- (insert string)
- (when render
- (let ((shr-use-fonts nil))
- (shr-render-region (point-min) (point-max))))
- (buffer-string))
- 'face face))
+ string
+ 'mastodon-tab-stop link-type
+ 'mouse-face 'highlight
+ 'keymap mastodon-tl--link-keymap
+ 'help-echo help-text)))
+
+(defun mastodon-tl--do-link-action-at-point (position)
+ (interactive "d")
+ (let ((link-type (get-text-property position 'mastodon-tab-stop)))
+ (cond ((eq link-type 'content-warning)
+ (mastodon-tl--toggle-spoiler-text position))
+ (t
+ (error "unknown link type %s" link-type)))))
+
+(defun mastodon-tl--do-link-action (event)
+ (interactive "e")
+ (mastodon-tl--do-link-action-at-point (posn-point (event-end event))))
+
+(defun mastodon-tl--has-spoiler (toot)
+ "Check if the given TOOT has a spoiler text that should initially be shown only while the main content should be hidden."
+ (let ((spoiler (mastodon-tl--field 'spoiler_text toot)))
+ (and spoiler (> (length spoiler) 0))))
(defun mastodon-tl--spoiler (toot)
- "Retrieve spoiler message from TOOT."
+ "Render TOOT with spoiler message.
+
+This assumes TOOT is a toot with a spoiler message.
+The main body gets hidden and only the spoiler text and the
+content warning message are displayed. The content warning
+message is a link which unhides/hides the main body."
(let* ((spoiler (mastodon-tl--field 'spoiler_text toot))
- (string (mastodon-tl--set-face spoiler 'default t))
- (message (concat "\n ---------------"
- "\n Content Warning"
- "\n ---------------\n"))
- (cw (mastodon-tl--set-face message 'mastodon-cw-face nil)))
- (if (> (length string) 0)
- (replace-regexp-in-string "\n\n\n ---------------"
- "\n ---------------" (concat string cw))
- "")))
+ (string (mastodon-tl--set-face
+ ;; remove trailing whitespace
+ (replace-regexp-in-string "[\t\n ]*\\'" ""
+ (mastodon-tl--render-text spoiler))
+ 'default))
+ (message (concat "\n"
+ " ---------------\n"
+ " " (mastodon-tl--make-link "Content Warning"
+ 'content-warning)
+ "\n"
+ " ---------------\n"))
+ (cw (mastodon-tl--set-face message 'mastodon-cw-face)))
+ (concat
+ string
+ cw
+ (propertize (mastodon-tl--content toot)
+ 'invisible t
+ 'mastodon-content-warning-body t))))
(defun mastodon-tl--media (toot)
"Retrieve a media attachment link for TOOT if one exists."
@@ -202,32 +465,35 @@ also render the html"
(lambda (media-attachement)
(let ((preview-url
(cdr (assoc 'preview_url media-attachement))))
- (mastodon-media--get-media-link-rendering
- preview-url)))
+ (if mastodon-tl--display-media-p
+ (mastodon-media--get-media-link-rendering
+ preview-url)
+ (concat "Media::" preview-url "\n"))))
media-attachements "")))
- (if (not (equal media-string ""))
- (concat "\n" media-string ) "")))
+ (if (not (and mastodon-tl--display-media-p
+ (equal media-string "")))
+ (concat "\n" media-string)
+ "")))
(defun mastodon-tl--content (toot)
"Retrieve text content from TOOT."
- (let ((content (mastodon-tl--field 'content toot))
- (shr-use-fonts nil))
- (propertize (with-temp-buffer
- (insert content)
- (shr-render-region (point-min) (point-max))
- (buffer-string))
- 'face 'default)))
+ (let ((content (mastodon-tl--field 'content toot)))
+ (concat
+ (mastodon-tl--render-text content)
+ (mastodon-tl--media toot))))
(defun mastodon-tl--toot (toot)
"Display TOOT content and byline."
(insert
(concat
- (mastodon-tl--spoiler toot)
- ;; remove two trailing newlines
- (substring (mastodon-tl--content toot) 0 -2)
- (mastodon-tl--media toot)
- "\n\n"
+ ;; remove trailing whitespace
+
+ (replace-regexp-in-string
+ "[\t\n ]*\\'" ""
+ (if (mastodon-tl--has-spoiler toot)
+ (mastodon-tl--spoiler toot)
+ (mastodon-tl--content toot)))
(mastodon-tl--byline toot)
"\n\n")))
@@ -237,7 +503,8 @@ also render the html"
(goto-char (point-min))
(while (search-forward "\n\n\n | " nil t)
(replace-match "\n | "))
- (mastodon-media--inline-images))
+ (when mastodon-tl--display-media-p
+ (mastodon-media--inline-images)))
(defun mastodon-tl--get-update-function (&optional buffer)
"Get the UPDATE-FUNCTION stored in `mastodon-tl--buffer-spec'"
@@ -267,7 +534,7 @@ also render the html"
"&"
"?")
"max_id="
- (number-to-string id)))))
+ (mastodon-tl--as-string id)))))
(mastodon-http--get-json url)))
;; TODO
@@ -280,7 +547,7 @@ also render the html"
"&"
"?")
"since_id="
- (number-to-string id)))))
+ (mastodon-tl--as-string id)))))
(mastodon-http--get-json url)))
(defun mastodon-tl--property (prop &optional backward)
@@ -304,21 +571,47 @@ Move forward (down) the timeline unless BACKWARD is non-nil."
(goto-char (point-max))
(mastodon-tl--property 'toot-id t))
+(defun mastodon-tl--as-string(numeric)
+ "Convert NUMERIC to string."
+ (cond ((numberp numeric)
+ (number-to-string numeric))
+ ((stringp numeric) numeric)
+ (t (error
+ "Numeric:%s must be either a string or a number"
+ numeric))))
+
+(defun mastodon-tl--toot-id (json)
+ "Find approproiate toot id in JSON.
+
+If the toot has been boosted use the id found in the
+reblog portion of the toot. Otherwise, use the body of
+the toot. This is the same behaviour as the mastodon.social
+webapp"
+ (let ((id (cdr (assoc 'id json)))
+ (reblog (cdr (assoc 'reblog json))))
+ (if reblog (cdr (assoc 'id reblog)) id)))
+
(defun mastodon-tl--thread ()
"Open thread buffer for toot under `point'."
(interactive)
- (let* ((id (number-to-string (mastodon-tl--property 'toot-id)))
+ (let* ((id (mastodon-tl--as-string (mastodon-tl--toot-id
+ (mastodon-tl--property 'toot-json))))
(url (mastodon-http--api (format "statuses/%s/context" id)))
(buffer (format "*mastodon-thread-%s*" id))
(toot (mastodon-tl--property 'toot-json))
(context (mastodon-http--get-json url)))
(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--timeline (vconcat
(cdr (assoc 'ancestors context))
`(,toot)
- (cdr (assoc 'descendants context)))))
- (mastodon-mode)))
+ (cdr (assoc 'descendants context)))))))
(defun mastodon-tl--more ()
"Append older toots to timeline."
@@ -334,6 +627,148 @@ Move forward (down) the timeline unless BACKWARD is non-nil."
(funcall update-function json)
(goto-char point-before)))))
+(defun mastodon-tl--find-property-range (property start-point &optional search-backwards)
+ " Returns `nil` if no such range is found.
+
+If PROPERTY is set at START-POINT returns a range around
+START-POINT otherwise before/after START-POINT.
+
+SEARCH-BACKWARDS determines whether we pick point
+before (non-nil) or after (nil)"
+ (if (get-text-property start-point property)
+ ;; We are within a range, so look backwards for the start:
+ (cons (previous-single-property-change
+ (if (equal start-point (point-max)) start-point (1+ start-point))
+ property nil (point-min))
+ (next-single-property-change start-point property nil (point-max)))
+ (if search-backwards
+ (let* ((end (or (previous-single-property-change
+ (if (equal start-point (point-max))
+ start-point (1+ start-point))
+ property)
+ ;; we may either be just before the range or there
+ ;; is nothing at all
+ (and (not (equal start-point (point-min)))
+ (get-text-property (1- start-point) property)
+ start-point)))
+ (start (and
+ end
+ (previous-single-property-change end property nil (point-min)))))
+ (when end
+ (cons start end)))
+ (let* ((start (next-single-property-change start-point property))
+ (end (and start
+ (next-single-property-change start property nil (point-max)))))
+ (when start
+ (cons start end))))))
+
+(defun mastodon-tl--find-next-or-previous-property-range
+ (property start-point search-backwards)
+ "Finds (start . end) range after/before START-POINT where PROPERTY is set to a consistent value (different from the value at START-POINT if that is set).
+
+Returns nil if no such range exists.
+
+If SEARCH-BACKWARDS is non-nil it find a region before
+START-POINT otherwise after START-POINT.
+"
+ (if (get-text-property start-point property)
+ ;; We are within a range, we need to start the search from
+ ;; before/after this range:
+ (let ((current-range (mastodon-tl--find-property-range property start-point)))
+ (if search-backwards
+ (unless (equal (car current-range) (point-min))
+ (mastodon-tl--find-property-range
+ property (1- (car current-range)) search-backwards))
+ (unless (equal (cdr current-range) (point-max))
+ (mastodon-tl--find-property-range
+ property (1+ (cdr current-range)) search-backwards))))
+ ;; If we are not within a range, we can just defer to
+ ;; mastodon-tl--find-property-range directly.
+ (mastodon-tl--find-property-range property start-point search-backwards)))
+
+(defun mastodon-tl--consider-timestamp-for-updates (timestamp)
+ "Take note that TIMESTAMP is used in buffer and ajust timers as needed.
+
+This calculates the next time the text for TIMESTAMP will change
+and may adjust existing or future timer runs should that time
+before current plans to run the update function.
+
+The adjustment is only made if it is significantly (a few
+seconds) before the currently scheduled time. This helps reduce
+the number of occasions where we schedule an update only to
+schedule the next one on completion to be within a few seconds.
+
+If relative timestamps are
+disabled (`mastodon-tl--enable-relative-timestamps` is nil) this
+is a no-op."
+ (when mastodon-tl--enable-relative-timestamps
+ (let ((this-update (cdr (mastodon-tl--relative-time-details timestamp))))
+ (when (time-less-p this-update
+ (time-subtract mastodon-tl--timestamp-next-update
+ (seconds-to-time 10)))
+ (setq mastodon-tl--timestamp-next-update this-update)
+ (when mastodon-tl--timestamp-update-timer
+ ;; We need to re-schedule for an earlier time
+ (cancel-timer mastodon-tl--timestamp-update-timer)
+ (setq mastodon-tl--timestamp-update-timer
+ (run-at-time this-update
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer) nil)))))))
+
+(defun mastodon-tl--update-timestamps-callback (buffer previous-marker)
+ "Update the next few timestamp displays in BUFFER.
+
+Start searching for more timestamps from PREVIOUS-MARKER or
+from the start if it is nil."
+ ;; only do things if the buffer hasn't been killed in the meantime
+ (when (and mastodon-tl--enable-relative-timestamps ;; should be true but just in case...
+ (buffer-live-p buffer))
+ (save-excursion
+ (with-current-buffer buffer
+ (let ((previous-timestamp (if previous-marker
+ (marker-position previous-marker)
+ (point-min)))
+ (iteration 0)
+ next-timestamp-range)
+ (if previous-marker
+ ;; This is a follow-up call to process the next batch of
+ ;; timestamps.
+ ;; Release the marker to not slow things down.
+ (set-marker previous-marker nil)
+ ;; Otherwise this is a rew run, so let's initialize the next-run time.
+ (setq mastodon-tl--timestamp-next-update (time-add (current-time)
+ (seconds-to-time 300))
+ mastodon-tl--timestamp-update-timer nil))
+ (while (and (< iteration 5)
+ (setq next-timestamp-range
+ (mastodon-tl--find-property-range 'timestamp
+ previous-timestamp)))
+ (let* ((start (car next-timestamp-range))
+ (end (cdr next-timestamp-range))
+ (timestamp (get-text-property start 'timestamp))
+ (current-display (get-text-property start 'display))
+ (new-display (mastodon-tl--relative-time-description timestamp)))
+ (unless (string= current-display new-display)
+ (let ((inhibit-read-only t))
+ (add-text-properties
+ start end (list 'display
+ (mastodon-tl--relative-time-description timestamp)))))
+ (mastodon-tl--consider-timestamp-for-updates timestamp)
+ (setq iteration (1+ iteration)
+ previous-timestamp (1+ (cdr next-timestamp-range)))))
+ (if next-timestamp-range
+ ;; schedule the next batch from the previous location to
+ ;; start very soon in the future:
+ (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer
+ (copy-marker previous-timestamp))
+ ;; otherwise we are done for now; schedule a new run for when needed
+ (setq mastodon-tl--timestamp-update-timer
+ (run-at-time mastodon-tl--timestamp-next-update
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ buffer nil))))))))
+
(defun mastodon-tl--update ()
"Update timeline with new toots."
(interactive)
@@ -346,7 +781,6 @@ Move forward (down) the timeline unless BACKWARD is non-nil."
(goto-char (point-min))
(funcall update-function json)))))
-
(defun mastodon-tl--init (buffer-name endpoint update-function)
"Initialize BUFFER-NAME with timeline targeted by ENDPOINT.
@@ -356,14 +790,25 @@ UPDATE-FUNCTION is used to recieve more toots."
(json (mastodon-http--get-json url)))
(with-output-to-temp-buffer buffer
(switch-to-buffer buffer)
+ (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
- (make-local-variable 'mastodon-tl--buffer-spec)
(setq mastodon-tl--buffer-spec
`(buffer-name ,buffer-name
endpoint ,endpoint update-function
- ,update-function)))
+ ,update-function)
+ mastodon-tl--timestamp-update-timer
+ (when mastodon-tl--enable-relative-timestamps
+ (run-at-time mastodon-tl--timestamp-next-update
+ nil ;; don't repeat
+ #'mastodon-tl--update-timestamps-callback
+ (current-buffer)
+ nil))))
buffer))
(provide 'mastodon-tl)