cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-03-15 11:50:03 +01:00
Code Issues

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

Browse Source
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 *thread-keymap*)
(define-key "X" #'refresh-thread-totally *thread-keymap*)
(define-key "v" #'open-message-attach *thread-keymap*) (define-key "v" #'open-message-attach *thread-keymap*)
(define-key "l" #'open-message-link *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) (program-events:push-event event)
all-mentions)) 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)) (when-let* ((tree (expand-status-tree status-id))
(event (make-instance 'program-events:save-timeline-in-db-event (event (make-instance 'program-events:save-timeline-in-db-event
:payload tree :payload tree
:timeline-type timeline :timeline-type timeline
:folder folder))) :folder folder
:force-saving-of-ignored-status
force-saving-of-ignored-status-p)))
(program-events:push-event event) (program-events:push-event event)
tree)) 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 :created-at)
(status-id folder timeline now)))))) (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) (defun add-to-followers (user-id)
(with-db-current-timestamp (now) (with-db-current-timestamp (now)
(query (make-insert +table-followed-user+ (query (make-insert +table-followed-user+

3
src/package.lisp
View File

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

79
src/program-events.lisp
View File

@ -349,43 +349,51 @@
(recover-count (recover-count
:initform 0 :initform 0
:initarg :recover-count :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)) (defmethod process-event ((object save-timeline-in-db-event))
"Update a timeline, save messages, performs topological sorts" "Update a timeline, save messages, performs topological sorts"
(let ((statuses (payload object)) (let ((statuses (payload object))
(ignored-count 0)) (ignored-count 0))
(with-accessors ((timeline-type timeline-type) (with-accessors ((timeline-type timeline-type)
(folder folder) (folder folder)
(min-id min-id) (min-id min-id)
(max-id max-id) (max-id max-id)
(kind kind) (kind kind)
(recover-count recover-count)) object (recover-count recover-count)
(force-saving-of-ignored-status-p force-saving-of-ignored-status-p)) object
#+debug-mode #+debug-mode
(let ((dump (with-output-to-string (stream) (let ((dump (with-output-to-string (stream)
(mapcar (lambda (toot) (tooter::present toot stream)) (mapcar (lambda (toot) (tooter::present toot stream))
statuses)))) statuses))))
(dbg "statuses ~a" dump)) (dbg "statuses ~a" dump))
(loop for status in statuses do (loop for status in statuses do
(let ((account-id (tooter:id (tooter:account status))) (let ((account-id (tooter:id (tooter:account status)))
(status-id (tooter:id status)) (status-id (tooter:id status))
(skip-this-status nil)) (skip-this-status nil))
(when (or (and (db:user-ignored-p account-id) (when force-saving-of-ignored-status-p
(not (db:status-skipped-p status-id folder timeline-type))) (db:remove-from-status-ignored status-id folder timeline-type))
(hooks:run-hook-until-success 'hooks:*skip-message-hook* (when (or (and (db:user-ignored-p account-id)
status (not (db:status-skipped-p status-id folder timeline-type)))
timeline-type (hooks:run-hook-until-success 'hooks:*skip-message-hook*
folder status
kind timeline-type
(localp object))) folder
(db:add-to-status-skipped status-id folder timeline-type) kind
(setf skip-this-status t) (localp object)))
(incf ignored-count)) (db:add-to-status-skipped status-id folder timeline-type)
(when (not skip-this-status) (setf skip-this-status t)
(db:update-db status (incf ignored-count))
:timeline timeline-type (when (not skip-this-status)
:folder folder (db:update-db status
:skip-ignored-p t)))) :timeline timeline-type
:folder folder
:skip-ignored-p t))))
(db:renumber-timeline-message-index timeline-type (db:renumber-timeline-message-index timeline-type
folder folder
:account-id nil) :account-id nil)
@ -906,13 +914,22 @@
((status-id ((status-id
:initform nil :initform nil
:initarg :status-id :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)) (defmethod process-event ((object expand-thread-event))
(with-accessors ((new-folder new-folder) (with-accessors ((new-folder new-folder)
(new-timeline new-timeline) (new-timeline new-timeline)
(status-id status-id)) object (status-id status-id)
(api-client:expand-status-thread status-id new-timeline new-folder))) (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) (defclass report-status-event (program-event)
((status-id ((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))))))) (push-event refresh-event)))))))
(%update-timeline-event #'update-payload))) (%update-timeline-event #'update-payload)))
(defun refresh-thread () (defun expand-status-tree (force)
"Check and download a thread
Force the checking for new message in the thread the selected message belong."
(flet ((update () (flet ((update ()
(when-let* ((selected-message (when-let* ((selected-message
(line-oriented-window:selected-row-fields *thread-window*)) (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*)) (folder (thread-window:timeline-folder *thread-window*))
(status-id (actual-author-message-id selected-message)) (status-id (actual-author-message-id selected-message))
(expand-event (make-instance 'expand-thread-event (expand-event (make-instance 'expand-thread-event
:force-saving-of-ignored-status force
:new-folder folder :new-folder folder
:new-timeline timeline :new-timeline timeline
:status-id status-id)) :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)))) (push-event refresh-event))))
(notify-procedure #'update (_ "Expanding thread")))) (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 () (defun refresh-tags ()
"Update messages for subscribed tags" "Update messages for subscribed tags"
(let* ((all-tags (db:all-subscribed-tags-name)) (let* ((all-tags (db:all-subscribed-tags-name))