diff options
| -rw-r--r-- | lisp/mastodon-tl.el | 204 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 340 | 
2 files changed, 539 insertions, 5 deletions
| diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 66452dd..c44ac01 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -46,13 +46,30 @@    :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")) +  (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,10 +163,75 @@ 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)) +        (parsed-time (date-to-time (mastodon-tl--field 'created_at toot)))          (faved (mastodon-tl--field 'favourited toot))          (boosted (mastodon-tl--field 'reblogged toot)))      (propertize @@ -163,7 +245,12 @@ Return value from boosted content if available."               (mastodon-tl--byline-author toot)               (mastodon-tl--byline-boosted toot)               " " -             (format-time-string mastodon-toot-timestamp-format (date-to-time timestamp)) +             (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 @@ -334,6 +421,104 @@ 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. + +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 +531,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 +540,24 @@ 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) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 8c706f5..8c7dc4c 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1,4 +1,5 @@  (require 'el-mock) +(require 'cl-macs)  (defconst mastodon-tl-test-base-toot    '((id . 61208) @@ -103,6 +104,106 @@        (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345"))        (mastodon-tl--more-json "timelines/foo" 12345)))) +(ert-deftest mastodon-tl--relative-time-description () +  "Should format relative time as expected" +  (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))) +              (format-seconds-since (seconds) +                                    (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") +    (check 59 "less than a minute ago") +    (check 60 "one minute ago") +    (check 89 "one minute ago")            ;; rounding down +    (check 91 "2 minutes ago")             ;; rounding up +    (check (minutes 3.49) "3 minutes ago") ;; rounding down +    (check (minutes 3.52) "4 minutes ago") +    (check (minutes 59) "59 minutes ago") +    (check (minutes 60) "one hour ago") +    (check (minutes 89) "one hour ago") +    (check (minutes 91) "2 hours ago") +    (check (hours 3.49) "3 hours ago") ;; rounding down +    (check (hours 3.51) "4 hours ago") ;; rounding down +    (check (hours 23.4) "23 hours ago") +    (check (hours 23.6) "one day ago") ;; rounding up +    (check (days 1.48) "one day ago")  ;; rounding down +    (check (days 1.52) "2 days ago")   ;; rounding up +    (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 (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) @@ -236,3 +337,242 @@   | (B) (F) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time    ------------"))))) +(ert-deftest mastodon-tl--byline-timestamp-has-relative-display () +  "Should display the timestamp with a relative time." +  (let ((mastodon-tl--show-avatars-p nil) +        (timestamp (cdr (assoc 'created_at mastodon-tl-test-base-toot)))) +    (with-mock +      (mock (date-to-time timestamp) => '(22782 21551)) +      (mock (current-time) => '(22782 22000)) +      (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") + +      (let* ((formatted-string (mastodon-tl--byline mastodon-tl-test-base-toot)) +             (timestamp-start (string-match "2999-99-99" formatted-string)) +             (properties (text-properties-at timestamp-start formatted-string))) +        (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))))))))) | 
