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

- optimized expanding of status trees that contains mentions; 

- fixed file path of Makefile.am;

- fixed typo.
This commit is contained in:
cage 2022-05-01 10:08:01 +02:00
parent fdfd9e5062
commit e07f4d2ee3
3 changed files with 25 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

@ -36,7 +36,7 @@ etc/init.lisp compare_version.awk
SUBDIRS = po SUBDIRS = po
dist_doc_DATA = README.org README.txt LICENSES.org CONTRIBUTING.org \ dist_doc_DATA = README.org README.txt LICENSES.org CONTRIBUTING.org \
doc/man.org doc/send-toot.lisp NEWS.org ChangeLog AUTHORS doc/tinmop.org doc/send-toot.lisp NEWS.org ChangeLog AUTHORS
confdir = $(sysconfdir)/$(PACKAGE) confdir = $(sysconfdir)/$(PACKAGE)

2
Makefile.in
View File

@ -401,7 +401,7 @@ etc/init.lisp compare_version.awk
SUBDIRS = po SUBDIRS = po
dist_doc_DATA = README.org README.txt LICENSES.org CONTRIBUTING.org \ dist_doc_DATA = README.org README.txt LICENSES.org CONTRIBUTING.org \
doc/man.org doc/send-toot.lisp NEWS.org ChangeLog AUTHORS doc/tinmop.org doc/send-toot.lisp NEWS.org ChangeLog AUTHORS
confdir = $(sysconfdir)/$(PACKAGE) confdir = $(sysconfdir)/$(PACKAGE)
dist_conf_DATA = etc/init.lisp etc/default-theme.conf etc/shared.conf dist_conf_DATA = etc/init.lisp etc/default-theme.conf etc/shared.conf

42
src/api-client.lisp
View File

@ -727,24 +727,28 @@ the latest 15 mentions)."
mentions-so-far)) mentions-so-far))
(defun update-mentions-folder (&key (delete-mentions-on-server t)) (defun update-mentions-folder (&key (delete-mentions-on-server t))
(when-let* ((all-mentions (all-mentions)) (let ((trees '()))
(trees (flatten (loop (when-let* ((all-mentions (all-mentions))
for mention in all-mentions (statuses (loop for mention in all-mentions
when (tooter:status mention) when (tooter:status mention)
collect collect (tooter:status mention))))
(expand-status-tree (tooter:status mention))))) (loop for status in statuses
(event (make-instance 'program-events:save-timeline-in-db-event when (not (member status trees))
:payload trees do
:timeline-type db:+home-timeline+ (loop for node in (expand-status-tree status)
:folder db:+mentions-status-folder+ do
:localp t (pushnew node trees)))
:min-id nil))) (let ((event (make-instance 'program-events:save-timeline-in-db-event
(when delete-mentions-on-server :payload trees
(map nil :timeline-type db:+home-timeline+
(lambda (m) (delete-notification (tooter:id m))) :folder db:+mentions-status-folder+
all-mentions)) :localp t
(program-events:push-event event) :min-id nil)))
all-mentions)) (when delete-mentions-on-server
(loop for mention in all-mentions do
(delete-notification (tooter:id mention))))
(program-events:push-event event)
all-mentions))))
(defun expand-status-thread (status-id timeline folder force-saving-of-ignored-status-p) (defun expand-status-thread (status-id timeline folder force-saving-of-ignored-status-p)
(when-let* ((tree (expand-status-tree status-id)) (when-let* ((tree (expand-status-tree status-id))
@ -789,7 +793,7 @@ node-status-id is not a leaf)."
(expand-status-tree (tooter:id object))) (expand-status-tree (tooter:id object)))
(defmethod expand-status-tree ((object string)) (defmethod expand-status-tree ((object string))
"Given a status id returns the complete mesaages tree this status belong." "Given a status id returns the complete messages tree this status belong."
(multiple-value-bind (root fetched-branch) (multiple-value-bind (root fetched-branch)
(climb-fetch-statuses object) (climb-fetch-statuses object)
(let ((res (copy-list fetched-branch))) (let ((res (copy-list fetched-branch)))