cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- fixed notify of new posts in subscribed tags.

This commit is contained in:
cage 2023-10-19 17:41:57 +02:00
parent 8be33e6df2
commit 2d58b91305
3 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/api-client.lisp
View File

@ -354,7 +354,7 @@ Returns nil if the user did not provided a server in the configuration file"
(defun update-pagination-statuses-so-far (statuses timeline folder (defun update-pagination-statuses-so-far (statuses timeline folder
&key &key
(event-priority program-events:+standard-event-priority+)) (event-priority program-events:+standard-event-priority+))
(loop for status in statuses do (loop for status in (nreverse (sort-id< statuses)) do
(let ((add-fetched-event (make-instance 'program-events:add-pagination-status-event (let ((add-fetched-event (make-instance 'program-events:add-pagination-status-event
:priority event-priority :priority event-priority
:status-id (tooter:id status) :status-id (tooter:id status)
@ -485,11 +485,11 @@ become an emty string (\"\")
(when-let ((tag-info (tooter:tag-information *client* tag))) (when-let ((tag-info (tooter:tag-information *client* tag)))
(tooter:history tag-info))) (tooter:history tag-info)))
(defun-api-call update-subscribed-tags (all-tags all-paginations &key (limit 20)) (defun-api-call update-subscribed-tags (all-tags all-max-id &key (limit 20))
"Update all tage in the list `all-tags'" "Update all tage in the list `all-tags'"
(loop (loop
for tag in all-tags for tag in all-tags
for max-id in (mapcar #'second all-paginations) for max-id in all-max-id
do do
(let ((tag-folder (db:tag->folder-name tag))) (let ((tag-folder (db:tag->folder-name tag)))
(update-timeline-tag tag (update-timeline-tag tag

12
src/db.lisp
View File

@ -2781,10 +2781,16 @@ nil if no such message exists"
(when-let* ((row (fetch-from-id +table-subscribed-tag+ tag))) (when-let* ((row (fetch-from-id +table-subscribed-tag+ tag)))
(let* ((last-status-id (db-getf row :last-status-id-fetched)) (let* ((last-status-id (db-getf row :last-status-id-fetched))
(max-status-id-fetched (max-status-id-subscribed-tag tag :include-ignored nil))) (max-status-id-fetched (max-status-id-subscribed-tag tag :include-ignored nil)))
(or (null last-status-id) (cond
(and max-status-id-fetched ((not (or last-status-id
max-status-id-fetched))
nil)
((null last-status-id)
t)
((and max-status-id-fetched
(string> max-status-id-fetched (string> max-status-id-fetched
last-status-id)))))) last-status-id))
t)))))
(defun all-tags-with-new-message-fetched () (defun all-tags-with-new-message-fetched ()
"Returns a list all the tags names that contains new messages, or nil "Returns a list all the tags names that contains new messages, or nil

12
src/ui-goodies.lisp
View File

@ -1029,10 +1029,12 @@ It an existing file path is provided the command will refuse to run."
(defun refresh-tags () (defun refresh-tags ()
"Update messages for subscribed tags" "Update messages for subscribed tags"
(let* ((all-tags (db:all-subscribed-tags-name))
(all-paginations (db:all-tag-paginations-status all-tags)))
(flet ((update () (flet ((update ()
(with-enqueued-process () (with-enqueued-process ()
(let* ((all-tags (db:all-subscribed-tags-name))
(all-max-id (loop for tag in all-tags
collect
(db::max-status-id-subscribed-tag tag :include-ignored t))))
(handler-bind ((tooter:request-failed (handler-bind ((tooter:request-failed
(lambda (e) (lambda (e)
(notify (format nil (notify (format nil
@ -1047,7 +1049,7 @@ It an existing file path is provided the command will refuse to run."
(type-of e)) (type-of e))
:as-error t) :as-error t)
(invoke-restart 'api-client::retry-ignoring-min-id)))) (invoke-restart 'api-client::retry-ignoring-min-id))))
(client:update-subscribed-tags all-tags all-paginations))) (client:update-subscribed-tags all-tags all-max-id)))
(let ((update-got-message-event (let ((update-got-message-event
(make-instance 'tag-mark-got-messages-event)) (make-instance 'tag-mark-got-messages-event))
(notify-event (notify-event
@ -1062,10 +1064,10 @@ It an existing file path is provided the command will refuse to run."
(push-event notify-event) (push-event notify-event)
(push-event update-subscribed-event) (push-event update-subscribed-event)
(push-event update-tag-histogram-events) (push-event update-tag-histogram-events)
(push-event refresh-window-event)))) (push-event refresh-window-event)))))
(notify (_ "Downloading tags messages")) (notify (_ "Downloading tags messages"))
(update) (update)
(notify (_ "Messages downloaded"))))) (notify (_ "Messages downloaded"))))
(defun confirm-selected-row-action (message) (defun confirm-selected-row-action (message)
(when-let* ((selected-row (line-oriented-window:selected-row-fields *thread-window*)) (when-let* ((selected-row (line-oriented-window:selected-row-fields *thread-window*))