From 2105887042e5bca3b364a04ed74aecc13d70ce7f Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Wed, 7 Jun 2017 18:29:10 +0100 Subject: Catch any errors thrown during url-retrieve. On Emacs24 I've been able to reliably fail url fetching which exposed issues in loading a timeline (it aborts the loading). This catches any errors, marking the image load as failed so that we won't retry (retries are a TODO item I guess) and then succeeds the function so the rest of the timeline loading can proceed. --- test/mastodon-media-tests.el | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'test') diff --git a/test/mastodon-media-tests.el b/test/mastodon-media-tests.el index 4bb89c7..7031e90 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -111,6 +111,24 @@ (let ((mastodon-media--preview-max-height 321)) (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) +(ert-deftest mastodon-media:load-image-from-url:url-fetching-fails () + "Should cope with failures in url-retrieve." + (let ((url "http://example.org/image.png") + (mastodon-media--avatar-height 123)) + (with-mock + (mock (image-type-available-p 'imagemagick) => t) + (mock (create-image * 'imagemagick t :height 123) => '(image foo)) + (stub url-retrieve => (error "url-retrieve failed")) + + (with-temp-buffer + (insert (concat "Start:" + (mastodon-media--get-avatar-rendering "http://example.org/img.png") + ":rest")) + + (should (eq :loading-failed (mastodon-media--load-image-from-url url 'avatar 7 1))) + ;; the media state was updated so we won't load this again: + (should (eq 'loading-failed (get-text-property 7 'media-state))))))) + (ert-deftest mastodon-media:process-image-response () "Should process the HTTP response and adjust the source buffer." (with-temp-buffer -- cgit v1.2.3 From 20e3b77a9a37373754d0adedcee2ede6cf1f5922 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Fri, 19 May 2017 22:10:38 +0100 Subject: Show the posting date in a more readable, relative to current time format. This is still static, i.e. doesn't update as time progresses. --- lisp/mastodon-tl.el | 38 ++++++++++++++++++++++++++++++++- test/mastodon-tl-tests.el | 54 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 91 insertions(+), 1 deletion(-) (limited to 'test') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 66452dd..4556613 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -146,6 +146,38 @@ 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. + +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))))))) + (defun mastodon-tl--byline (toot) "Generate byline for TOOT." (let ((id (cdr (assoc 'id toot))) @@ -163,7 +195,11 @@ 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)) + (let ((parsed-time (date-to-time timestamp))) + (propertize + (format-time-string mastodon-toot-timestamp-format parsed-time) + 'timestamp parsed-time + 'display (mastodon-tl--relative-time-description parsed-time))) (propertize "\n ------------" 'face 'default)) 'favourited-p faved 'boosted-p boosted diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 8c706f5..ed16b1b 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,44 @@ (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 ((time-stamp (time-subtract (current-time) (seconds-to-time seconds)))) + (mastodon-tl--relative-time-description time-stamp))) + (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 (weeks 52) "52 weeks ago") + (check (weeks 53) "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--byline-regular () "Should format the regular toot correctly." (let ((mastodon-tl--show-avatars-p nil) @@ -236,3 +275,18 @@ | (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))))))) + -- cgit v1.2.3 From 746694f0ea75f5fa76739d49509836ccd67d7d65 Mon Sep 17 00:00:00 2001 From: Holger Dürer 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. --- lisp/mastodon-tl.el | 204 +++++++++++++++++++++++++++----- test/mastodon-tl-tests.el | 294 +++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 463 insertions(+), 35 deletions(-) (limited to 'test') 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) 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