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
&key
(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
:priority event-priority
:status-id (tooter:id status)
@ -485,11 +485,11 @@ become an emty string (\"\")
(when-let ((tag-info (tooter:tag-information *client* tag)))
(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'"
(loop
for tag in all-tags
for max-id in (mapcar #'second all-paginations)
for max-id in all-max-id
do
(let ((tag-folder (db:tag->folder-name tag)))
(update-timeline-tag tag

14
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)))
(let* ((last-status-id (db-getf row :last-status-id-fetched))
(max-status-id-fetched (max-status-id-subscribed-tag tag :include-ignored nil)))
(or (null last-status-id)
(and max-status-id-fetched
(string> max-status-id-fetched
last-status-id))))))
(cond
((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
last-status-id))
t)))))
(defun all-tags-with-new-message-fetched ()
"Returns a list all the tags names that contains new messages, or nil

20
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 ()
"Update messages for subscribed tags"
(let* ((all-tags (db:all-subscribed-tags-name))
(all-paginations (db:all-tag-paginations-status all-tags)))
(flet ((update ()
(with-enqueued-process ()
(flet ((update ()
(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
(lambda (e)
(notify (format nil
@ -1047,7 +1049,7 @@ It an existing file path is provided the command will refuse to run."
(type-of e))
:as-error t)
(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
(make-instance 'tag-mark-got-messages-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 update-subscribed-event)
(push-event update-tag-histogram-events)
(push-event refresh-window-event))))
(notify (_ "Downloading tags messages"))
(update)
(notify (_ "Messages downloaded")))))
(push-event refresh-window-event)))))
(notify (_ "Downloading tags messages"))
(update)
(notify (_ "Messages downloaded"))))
(defun confirm-selected-row-action (message)
(when-let* ((selected-row (line-oriented-window:selected-row-fields *thread-window*))