Add periodic updating of the timestamp displays.

For each buffer we add a timer that periodically checks all timestamps and updates them as needed.
The logic tries to be smart and
- only schedule an update when at least one timestamps display needs changing (although at the moment we update at least every 5 minutes), and
- only do a limited amount of work in each timer callback so as to not block Emacs's interactive work.

1 files changed, 173 insertions, 31 deletions

diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 4556613..caa5249 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -48,11 +48,20 @@
 
 (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--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)
+
 
 (defun mastodon-tl--get-federated-timeline ()
   "Opens federated timeline."
@@ -146,37 +155,70 @@ Return value from boosted content if available."
   (or (cdr (assoc field (cdr (assoc 'reblog toot))))
       (cdr (assoc field toot))))
 
-(defun mastodon-tl--relative-time-description (time-stamp)
-  "Returns a string with a human readable description of TIME-STMAP relative to the current time.
+(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."
-  (let* ((now (current-time))
-         (time-difference (time-subtract now time-stamp))
-         (seconds-difference (float-time time-difference)))
-    (cond
-     ((< seconds-difference 60)
-      "less than a minute ago")
-     ((<= seconds-difference (* 1.5 60))
-      "one minute ago")
-     ((< seconds-difference (* 60 59.5))
-      (format "%d minutes ago" (round (/ seconds-difference 60))))
-     ((<= seconds-difference (* 1.5 60 60))
-      "one hour ago")
-     ((< seconds-difference (* 60 60 23.5))
-      (format "%d hours ago" (round (/ seconds-difference 60 60))))
-     ((<= seconds-difference (* 1.5 60 60 24))
-      "one day ago")
-     ((<= seconds-difference (* 60 60 24 6.5))
-      (format "%d days ago" (round (/ seconds-difference 60 60 24))))
-     ((<= seconds-difference (* 1.5 60 60 24 7))
-      "one week ago")
-     ((<= seconds-difference (* 60 60 24 365))
-      (format "%d weeks ago" (round (/ seconds-difference 60 60 24 7))))
-     ((<= seconds-difference (* 1.5 60 60 24 365))
-      "one year ago")
-     (t
-      (format "%d years ago" (round (/ seconds-difference 60 60 24 365.25)))))))
+  (car (mastodon-tl--relative-time-details timestamp current-time)))
 
 (defun mastodon-tl--byline (toot)
   "Generate byline for TOOT."
@@ -370,6 +412,98 @@ 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)
+  "Finds (start . end) range around or after START-POINT where PROPERTY is set to a consistent value.
+
+If PROPERTY is set at START-POINT returns a range aroung
+START-POINT otherwise after START-POINT."
+  (if (get-text-property start-point property)
+      ;; We are within a range, so look backwards for the start:
+      (cons (or (previous-single-property-change start-point property)
+                (point-min))
+            (or (next-single-property-change start-point property)
+                (point-max)))
+    (let* ((start (next-single-property-change start-point property))
+           (end (and start
+                     (or (next-single-property-change start property)
+                         (point-max)))))
+      (when start
+        (cons start end)))))
+
+(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."
+  (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 (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)
@@ -382,7 +516,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.
 
@@ -392,14 +525,23 @@ 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 (run-at-time mastodon-tl--timestamp-next-update
+                                                             nil ;; don't repeat
+                                                             #'mastodon-tl--update-timestamps-callback
+                                                             (current-buffer)
+                                                             nil)))
     buffer))
 
 (provide 'mastodon-tl)