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

- added feature: expand tree of posts fetching again even posts that was deleted before.

This commit is contained in:
cage 2021-06-13 14:07:47 +02:00
parent 8ea2f82bd6
commit b4a3dfabde
6 changed files with 85 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/init.lisp
View File

@ -235,6 +235,8 @@
(define-key "x" #'refresh-thread *thread-keymap*)
(define-key "X" #'refresh-thread-totally *thread-keymap*)
(define-key "v" #'open-message-attach *thread-keymap*)
(define-key "l" #'open-message-link *thread-keymap*)

6
src/api-client.lisp
View File

@ -715,12 +715,14 @@ the latest 15 mentions)."
(program-events:push-event event)
all-mentions))
(defun expand-status-thread (status-id timeline folder)
(defun expand-status-thread (status-id timeline folder force-saving-of-ignored-status-p)
(when-let* ((tree (expand-status-tree status-id))
(event (make-instance 'program-events:save-timeline-in-db-event
:payload tree
:timeline-type timeline
:folder folder)))
:folder folder
:force-saving-of-ignored-status
force-saving-of-ignored-status-p)))
(program-events:push-event event)
tree))

12
src/db.lisp
View File

@ -2506,6 +2506,18 @@ status has been downloaded from the net and ignored because belog to an ignored
(:status-id :folder :timeline :created-at)
(status-id folder timeline now))))))
(defun remove-from-status-skipped (status-id folder timeline)
(query (make-delete +table-skipped-status+
(:and (:= :status-id status-id)
(:= :folder folder)
(:= :timeline timeline)))))
(defun remove-from-status-ignored (status-id folder timeline)
(query (make-delete +table-ignored-status+
(:and (:= :status-id status-id)
(:= :folder folder)
(:= :timeline timeline)))))
(defun add-to-followers (user-id)
(with-db-current-timestamp (now)
(query (make-insert +table-followed-user+

3
src/package.lisp
View File

@ -937,6 +937,8 @@
:status-skipped-p
:add-to-status-ignored
:add-to-status-skipped
:remove-from-status-skipped
:remove-from-status-ignored
:add-to-followers
:remove-from-followers
:forget-all-statuses-marked-deleted
@ -2423,6 +2425,7 @@
:update-current-timeline
:update-current-timeline-backwards
:refresh-thread
:refresh-thread-totally
:refresh-tags
:favourite-selected-status
:unfavourite-selected-status

79
src/program-events.lisp
View File

@ -349,43 +349,51 @@
(recover-count
:initform 0
:initarg :recover-count
:accessor recover-count)))
:accessor recover-count)
(force-saving-of-ignored-status
:initform nil
:initarg :force-saving-of-ignored-status
:reader force-saving-of-ignored-status-p
:writer (setf force-saving-of-ignored-status))))
(defmethod process-event ((object save-timeline-in-db-event))
"Update a timeline, save messages, performs topological sorts"
(let ((statuses (payload object))
(ignored-count 0))
(with-accessors ((timeline-type timeline-type)
(folder folder)
(min-id min-id)
(max-id max-id)
(kind kind)
(recover-count recover-count)) object
(with-accessors ((timeline-type timeline-type)
(folder folder)
(min-id min-id)
(max-id max-id)
(kind kind)
(recover-count recover-count)
(force-saving-of-ignored-status-p force-saving-of-ignored-status-p)) object
#+debug-mode
(let ((dump (with-output-to-string (stream)
(mapcar (lambda (toot) (tooter::present toot stream))
statuses))))
(dbg "statuses ~a" dump))
(loop for status in statuses do
(let ((account-id (tooter:id (tooter:account status)))
(status-id (tooter:id status))
(skip-this-status nil))
(when (or (and (db:user-ignored-p account-id)
(not (db:status-skipped-p status-id folder timeline-type)))
(hooks:run-hook-until-success 'hooks:*skip-message-hook*
status
timeline-type
folder
kind
(localp object)))
(db:add-to-status-skipped status-id folder timeline-type)
(setf skip-this-status t)
(incf ignored-count))
(when (not skip-this-status)
(db:update-db status
:timeline timeline-type
:folder folder
:skip-ignored-p t))))
(let ((account-id (tooter:id (tooter:account status)))
(status-id (tooter:id status))
(skip-this-status nil))
(when force-saving-of-ignored-status-p
(db:remove-from-status-ignored status-id folder timeline-type))
(when (or (and (db:user-ignored-p account-id)
(not (db:status-skipped-p status-id folder timeline-type)))
(hooks:run-hook-until-success 'hooks:*skip-message-hook*
status
timeline-type
folder
kind
(localp object)))
(db:add-to-status-skipped status-id folder timeline-type)
(setf skip-this-status t)
(incf ignored-count))
(when (not skip-this-status)
(db:update-db status
:timeline timeline-type
:folder folder
:skip-ignored-p t))))
(db:renumber-timeline-message-index timeline-type
folder
:account-id nil)
@ -906,13 +914,22 @@
((status-id
:initform nil
:initarg :status-id
:accessor status-id)))
:accessor status-id)
(force-saving-of-ignored-status
:initform nil
:initarg :force-saving-of-ignored-status
:reader force-saving-of-ignored-status-p
:writer (setf force-saving-of-ignored-status))))
(defmethod process-event ((object expand-thread-event))
(with-accessors ((new-folder new-folder)
(new-timeline new-timeline)
(status-id status-id)) object
(api-client:expand-status-thread status-id new-timeline new-folder)))
(with-accessors ((new-folder new-folder)
(new-timeline new-timeline)
(status-id status-id)
(force-saving-of-ignored-status-p force-saving-of-ignored-status-p)) object
(api-client:expand-status-thread status-id
new-timeline
new-folder
force-saving-of-ignored-status-p)))
(defclass report-status-event (program-event)
((status-id

20
src/ui-goodies.lisp
View File

@ -680,10 +680,7 @@ Starting from the oldest toot and going back."
(push-event refresh-event)))))))
(%update-timeline-event #'update-payload)))
(defun refresh-thread ()
"Check and download a thread
Force the checking for new message in the thread the selected message belong."
(defun expand-status-tree (force)
(flet ((update ()
(when-let* ((selected-message
(line-oriented-window:selected-row-fields *thread-window*))
@ -691,6 +688,7 @@ Force the checking for new message in the thread the selected message belong."
(folder (thread-window:timeline-folder *thread-window*))
(status-id (actual-author-message-id selected-message))
(expand-event (make-instance 'expand-thread-event
:force-saving-of-ignored-status force
:new-folder folder
:new-timeline timeline
:status-id status-id))
@ -700,6 +698,20 @@ Force the checking for new message in the thread the selected message belong."
(push-event refresh-event))))
(notify-procedure #'update (_ "Expanding thread"))))
(defun refresh-thread ()
"Check and download a thread
Expand the post until all the reply and parents are downloaded."
(expand-status-tree nil))
(defun refresh-thread-totally ()
"Check and download a thread
Expand the post until all the reply and parents are downloaded.
If some posts was deleted before, download them again."
(expand-status-tree t))
(defun refresh-tags ()
"Update messages for subscribed tags"
(let* ((all-tags (db:all-subscribed-tags-name))