From 746694f0ea75f5fa76739d49509836ccd67d7d65 Mon Sep 17 00:00:00 2001
From: Holger Dürer <me@hdurer.net>
Date: Sat, 20 May 2017 20:00:24 +0100
Subject: 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.
---
 test/mastodon-tl-tests.el | 294 +++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 290 insertions(+), 4 deletions(-)

(limited to 'test/mastodon-tl-tests.el')

diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index ed16b1b..8c7dc4c 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -112,8 +112,8 @@
               (weeks (n) (* n (days 7)))
               (years (n) (* n (days 365)))
               (format-seconds-since (seconds)
-                                    (let ((time-stamp (time-subtract (current-time) (seconds-to-time seconds))))
-                                      (mastodon-tl--relative-time-description time-stamp)))
+                                    (let ((timestamp (time-subtract (current-time) (seconds-to-time seconds))))
+                                      (mastodon-tl--relative-time-description timestamp)))
               (check (seconds expected)
                      (should (string= (format-seconds-since seconds) expected))))
     (check 1 "less than a minute ago")
@@ -136,12 +136,74 @@
     (check (days 6.6) "one week ago")  ;; rounding up
     (check (weeks 2.49) "2 weeks ago") ;; rounding down
     (check (weeks 2.51) "3 weeks ago") ;; rounding down
-    (check (weeks 52) "52 weeks ago") 
-    (check (weeks 53) "one year ago") 
+    (check (1- (weeks 52)) "52 weeks ago")
+    (check (weeks 52) "one year ago")
     (check (years 2.49) "2 years ago") ;; rounding down
     (check (years 2.51) "3 years ago") ;; rounding down
     ))
 
+(ert-deftest mastodon-tl--relative-time-details--next-update ()
+  "Should calculate the next update time information as expected"
+  (let ((current-time (current-time)))
+    (cl-labels ((minutes (n) (* n 60))
+                (hours (n) (* n (minutes 60)))
+                (days (n) (* n (hours 24)))
+                (weeks (n) (* n (days 7)))
+                (years (n) (* n (days 365.25)))
+                (next-update (seconds-ago)
+                             (let* ((timestamp (time-subtract current-time
+                                                              (seconds-to-time seconds-ago))))
+                               (cdr (mastodon-tl--relative-time-details timestamp current-time))))
+                (check (seconds-ago)
+                       (let* ((timestamp (time-subtract current-time (seconds-to-time seconds-ago)))
+                              (at-now (mastodon-tl--relative-time-description timestamp current-time))
+                              (at-one-second-before (mastodon-tl--relative-time-description
+                                                     timestamp
+                                                     (time-subtract (next-update seconds-ago)
+                                                                    (seconds-to-time 1))))
+                              (at-result (mastodon-tl--relative-time-description
+                                          timestamp
+                                          (next-update seconds-ago))))
+                         (when nil  ;; change to t to debug test failures
+                           (prin1 (format "\nFor %s: %s / %s"
+                                          seconds-ago
+                                          (time-to-seconds
+                                           (time-subtract (next-update seconds-ago)
+                                                          timestamp))
+                                          (round
+                                           (time-to-seconds
+                                            (time-subtract (next-update seconds-ago)
+                                                           current-time))))))
+                         ;; a second earlier the description is the same as at current time
+                         (should (string= at-now at-one-second-before))
+                         ;; but at the result time it is different
+                         (should-not (string= at-one-second-before at-result)))))
+      (check 0)
+      (check 1)
+      (check 59)
+      (check 60)
+      (check 89)
+      (check 90)
+      (check 149)
+      (check 150)
+      (check (1- (hours 1.5))) ;; just before we switch from "one hour" to "2 hours"
+      (check (hours 1.5))
+      (check (hours 2.1))
+      (check (1- (hours 23.5))) ;; just before "23 hours" -> "one day"
+      (check (hours 23.5))
+      (check (1- (days 1.5))) ;; just before "one day" -> "2 days"
+      (check (days 1.5)) ;; just before "one day" -> "2 days"
+      (check (days 2.1))
+      (check (1- (days 6.5))) ;; just before "6 days" -> "one week"
+      (check (days 6.5)) ;; "one week" -> "2 weeks"
+      (check (weeks 2.1))
+      (check (1- (weeks 52))) ;; just before "52 weeks" -> "one year"
+      (check (weeks 52))
+      (check (days 365))
+      (check (days 366))
+      (check (years 2.1))
+      )))
+
 (ert-deftest mastodon-tl--byline-regular ()
   "Should format the regular toot correctly."
   (let ((mastodon-tl--show-avatars-p nil)
@@ -290,3 +352,227 @@
         (should (equal '(22782 21551) (plist-get properties 'timestamp)))
         (should (string-equal "7 minutes ago" (plist-get properties 'display)))))))
 
+(ert-deftest mastodon-tl--consider-timestamp-for-updates-no-active-callback ()
+  "Should update the timestamp update variables as expected."
+
+  (let* ((now (current-time))
+         (soon-in-the-future (time-add now (seconds-to-time 10000)))
+         (long-in-the-future (time-add now (seconds-to-time 10000000))))
+    (with-temp-buffer
+      ;; start with timer way into the future and no active callback
+      (setq mastodon-tl--timestamp-next-update long-in-the-future
+            mastodon-tl--timestamp-update-timer nil)
+
+      ;; something a later update doesn't update:
+      (with-mock
+        (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+              (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100))))
+
+        (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+        (should (null mastodon-tl--timestamp-update-timer))
+        (should (eq mastodon-tl--timestamp-next-update long-in-the-future)))
+
+      ;; something only shortly sooner doesn't update:
+      (with-mock
+        (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+              (cons "xxx ago" (time-subtract long-in-the-future (seconds-to-time 9))))
+
+        (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+        (should (null mastodon-tl--timestamp-update-timer))
+        (should (eq mastodon-tl--timestamp-next-update long-in-the-future)))
+
+      ;; something much sooner, does update
+      (with-mock
+        (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+              (cons "xxx ago"  soon-in-the-future))
+
+        (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+        (should (null mastodon-tl--timestamp-update-timer))
+        (should (eq mastodon-tl--timestamp-next-update soon-in-the-future)))
+      )))
+
+(ert-deftest mastodon-tl--consider-timestamp-for-updates-with-active-callback ()
+  "Should update the timestamp update variables as expected."
+
+  (let* ((now (current-time))
+         (soon-in-the-future (time-add now (seconds-to-time 10000)))
+         (long-in-the-future (time-add now (seconds-to-time 10000000))))
+    (with-temp-buffer
+      ;; start with timer way into the future and no active callback
+      (setq mastodon-tl--timestamp-next-update long-in-the-future
+            mastodon-tl--timestamp-update-timer 'initial-timer)
+
+      ;; something a later update doesn't update:
+      (with-mock
+        (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+              (cons "xxx ago" (time-add long-in-the-future (seconds-to-time 100))))
+
+        (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+        (should (eq 'initial-timer mastodon-tl--timestamp-update-timer))
+        (should (eq mastodon-tl--timestamp-next-update long-in-the-future)))
+
+      ;; something much sooner, does update
+      (with-mock
+        (mock (mastodon-tl--relative-time-details 'fake-timestamp) =>
+              (cons "xxx ago"  soon-in-the-future))
+        (mock (cancel-timer 'initial-timer))
+        (mock (run-at-time soon-in-the-future nil
+                           #'mastodon-tl--update-timestamps-callback
+                           (current-buffer) nil) => 'new-timer)
+
+        (mastodon-tl--consider-timestamp-for-updates 'fake-timestamp)
+
+        (should (eq 'new-timer mastodon-tl--timestamp-update-timer))
+        (should (eq mastodon-tl--timestamp-next-update soon-in-the-future)))
+      )))
+
+(ert-deftest mastodon-tl--find-property-range--no-tag ()
+  "Should cope with a buffer completely lacking the tag."
+  (with-temp-buffer
+    (insert "Just some random text")
+    (insert (propertize "More text with a different property" 'other-property 'set))
+
+    (should (null (mastodon-tl--find-property-range 'test-property 2)))))
+
+(ert-deftest mastodon-tl--find-property-range--earlier-tag ()
+  "Should cope with a buffer completely lacking the tag."
+  (with-temp-buffer
+    (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+    (let ((end-of-region (point)))
+      (insert "More random text")
+
+      (should (null (mastodon-tl--find-property-range 'test-property end-of-region))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding ()
+  "Should find the sought tag in all expected circumstances."
+  (with-temp-buffer
+    (insert "Previous text")
+    (let ((start-of-region (point))
+          end-of-region)
+      (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+      (setq end-of-region (point))
+      (insert "More random text")
+
+      ;; before the region
+      (should (equal (cons start-of-region end-of-region)
+                     (mastodon-tl--find-property-range 'test-property 1)))
+      ;; in the region
+      (should (equal (cons start-of-region end-of-region)
+                     (mastodon-tl--find-property-range 'test-property (+ 2 start-of-region))))
+      ;; at end of region
+      (should (equal (cons start-of-region end-of-region)
+                     (mastodon-tl--find-property-range 'test-property (1- end-of-region)))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding-at-start ()
+  "Should cope with a tag at start."
+  (with-temp-buffer
+    (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+    (let ((end-of-region (point)))
+      (insert "More random text")
+
+      ;; at start of the region
+      (should (equal (cons 1 end-of-region)
+                     (mastodon-tl--find-property-range 'test-property 1)))
+      ;; in the region
+      (should (equal (cons 1 end-of-region)
+                     (mastodon-tl--find-property-range 'test-property 3)))
+      ;; at end of region
+      (should (equal (cons 1 end-of-region)
+                     (mastodon-tl--find-property-range 'test-property (1- end-of-region)))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding-at-end ()
+  "Should cope with a tag at end."
+  (with-temp-buffer
+    (insert "More random text")
+    (let ((start-of-region (point))
+          end-of-region)
+      (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+      (setq end-of-region (point-max))
+
+      ;; before the region
+      (should (equal (cons start-of-region end-of-region)
+                     (mastodon-tl--find-property-range 'test-property 1)))
+      ;; in the region
+      (should (equal (cons start-of-region end-of-region)
+                     (mastodon-tl--find-property-range 'test-property (1+ start-of-region))))
+      ;; at end of region
+      (should (equal (cons start-of-region end-of-region)
+                     (mastodon-tl--find-property-range 'test-property (1- end-of-region)))))))
+
+(ert-deftest mastodon-tl--find-property-range--successful-finding-whole-buffer ()
+  "Should cope with a tag being set for the whole buffer."
+  (with-temp-buffer
+    (insert (propertize "Just some text with a the sought property" 'test-property 'set))
+
+    ;; before the region
+    (should (equal (cons (point-min) (point-max))
+                   (mastodon-tl--find-property-range 'test-property 2)))))
+
+(defun tl-tests--all-regions-with-property (property)
+  "Returns a list with (start . end) regions where PROPERTY is set."
+  (let (result
+        region)
+    (goto-char (point-min))
+    (while (and (< (point) (point-max))
+                (setq region (mastodon-tl--find-property-range property (point))))
+      (push region result)
+      (goto-char (min (point-max) (cdr region))))
+    (nreverse result)))
+
+(defun tl-tests--property-values-at (property ranges)
+  "Returns a list with property values at the given ranges.
+
+The property value for PROPERTY within a region is assumed to be
+constant."
+  (let (result)
+    (dolist (range ranges (nreverse result))
+      (push (get-text-property (car range) property) result))))
+
+(ert-deftest mastodon-tl--update-timestamps-callback ()
+  "Should update the 5 timestamps at a time as expected."
+  (let ((now (current-time))
+        markers)
+    (cl-labels ((insert-timestamp (n)
+                                  (insert (format "\nSome text before timestamp %s:" n))
+                                  (insert (propertize
+                                           (format "timestamp #%s" n)
+                                           'timestamp (time-subtract now (seconds-to-time (* 60 n)))
+                                           'display (format "unset %s" n)))
+                                  (push (copy-marker (point)) markers)
+                                  (insert " some more text.")))
+      (with-temp-buffer
+        (cl-dotimes (n 12) (insert-timestamp (+ n 2)))
+        (setq markers (nreverse markers))
+        
+        (with-mock
+          (mock (current-time) => now)
+          (stub run-at-time => 'fake-timer)
+
+          ;; make the initial call
+          (mastodon-tl--update-timestamps-callback (current-buffer) nil)
+          (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago"
+                           "unset 7" "unset 8" "unset 9" "unset 10" "unset 11" "unset 12" "unset 13")
+                         (tl-tests--property-values-at 'display
+                                                       (tl-tests--all-regions-with-property 'timestamp))))
+
+          ;; fake the follow-up call
+          (mastodon-tl--update-timestamps-callback (current-buffer) (nth 4 markers))
+          (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago"
+                           "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago"
+                           "unset 12" "unset 13")
+                         (tl-tests--property-values-at 'display
+                                                       (tl-tests--all-regions-with-property 'timestamp))))
+          (should (null (marker-position (nth 4 markers))))
+
+          ;; fake the follow-up call
+          (mastodon-tl--update-timestamps-callback (current-buffer) (nth 9 markers))
+          (should (equal '("2 minutes ago" "3 minutes ago" "4 minutes ago" "5 minutes ago" "6 minutes ago"
+                           "7 minutes ago" "8 minutes ago" "9 minutes ago" "10 minutes ago" "11 minutes ago"
+                           "12 minutes ago" "13 minutes ago")
+                         (tl-tests--property-values-at 'display
+                                                       (tl-tests--all-regions-with-property 'timestamp))))
+          (should (null (marker-position (nth 9 markers)))))))))
-- 
cgit v1.2.3