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

- prevent skipping of messages for subscribed tags; 

- changed keys for tags window.
This commit is contained in:
cage 2020-05-14 20:23:40 +02:00
parent bc4d42d847
commit 37e8e49abf
5 changed files with 28 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/init.lisp
View File

@ -274,9 +274,9 @@
(define-key "C-J" #'open-tag-folder *tags-keymap*)
(define-key "C-X m u" #'unsubscribe-to-hash *tags-keymap*)
(define-key "U" #'unsubscribe-to-hash *tags-keymap*)
(define-key "C-t h r" #'refresh-tags *tags-keymap*)
(define-key "r" #'refresh-tags *tags-keymap*)
;; conversations keymap

12
src/api-client.lisp
View File

@ -355,6 +355,9 @@ authorizations was performed with success."
:folder folder
:localp nil
:min-id min-id)))
(update-pagination-statuses-so-far timeline-statuses
db:+default-tag-timeline+
folder)
(program-events:push-event save-timeline-in-db-event))))
(defun tag-name (tag &key (return-empty-string-if-nil nil))
@ -369,15 +372,18 @@ become an emty string (\"\")
""
nil))))
(defun-w-lock update-subscribed-tags (all-tags &key min-id (limit 20))
(defun-w-lock update-subscribed-tags (all-tags all-paginations &key (limit 20))
*client-lock*
"Update all tage in the list `all-tags'"
(loop for tag in all-tags do
(loop
for tag in all-tags
for max-id in (mapcar #'second all-paginations)
do
(let ((tag-folder (db:tag->folder-name tag)))
(update-timeline-tag tag
tag-folder
:limit limit
:min-id min-id))))
:min-id max-id))))
(defun-w-lock fetch-remote-status (status-id)
*client-lock*

12
src/db.lisp
View File

@ -422,6 +422,7 @@
(create-table-index +table-attachment+ '(:id))
(create-table-index +table-subscribed-tag+ '(:id))
(create-table-index +table-ignored-status+ '(:folder :timeline :status-id))
(create-table-index +table-pagination-status+ '(:folder :timeline :status-id))
(create-table-index +table-conversation+ '(:id))
(create-table-index +table-cache+ '(:id :key)))
@ -1997,6 +1998,17 @@ account that wrote the status identified by `status-id'"
tag
(strcat +folder-tag-prefix+ tag)))
(defun tag->paginations-status (tag timeline)
(let ((folder (tag->folder-name tag)))
(values (first-pagination-status-id-timeline-folder timeline folder)
(last-pagination-status-id-timeline-folder timeline folder))))
(defun all-tag-paginations-status (tags &optional (timeline +default-tag-timeline+))
(loop for tag in tags collect
(multiple-value-bind (oldest newest)
(tag->paginations-status tag timeline)
(list oldest newest))))
(defun folder-name->tag (folder)
"Strip the tag prefix (usually '#') from tag name to get the folder
name"

1
src/package.lisp
View File

@ -824,6 +824,7 @@
:unsubscribe-to-tag
:tag->folder-name
:folder-name->tag
:all-tag-paginations-status
:all-subscribed-tags
:all-subscribed-tags-name
:tag-folder-name-p

7
src/ui-goodies.lisp
View File

@ -503,7 +503,7 @@ Starting from the oldest toot and going back."
folder
:max-id min-id
:local localp)
(let ((refresh-event (make-instance 'refresh-thread-windows-event)))
(let ((refresh-event (make-instance 'refresh-thread-windows-event)))
(push-event refresh-event)))))
(notify-procedure #'update
(_ "Downloading messages.")
@ -512,9 +512,10 @@ Starting from the oldest toot and going back."
(defun refresh-tags ()
"Update messages for subscribed tags"
(let ((all-tags (db:all-subscribed-tags-name)))
(let* ((all-tags (db:all-subscribed-tags-name))
(all-paginations (db:all-tag-paginations-status all-tags)))
(flet ((update ()
(client:update-subscribed-tags all-tags)
(client:update-subscribed-tags all-tags all-paginations)
(let ((update-got-message-event
(make-instance 'tag-mark-got-messages-event))
(notify-event