From 5f00107808efa0436c1583a07c7bbe69a1adc8c8 Mon Sep 17 00:00:00 2001 From: cage Date: Thu, 14 May 2020 16:32:01 +0200 Subject: [PATCH] - prevented skipping of statuses when updatig timeline (so i hope); - added the possibility to update a timeline going backward; - added two new key to delete a status and move to next or previous one. --- etc/init.lisp | 2 ++ etc/next-previous-open.lisp | 16 +++++++++++-- src/api-client.lisp | 32 +++++++++++++++++++++----- src/db.lisp | 45 +++++++++++++++++++++++++++++++++++-- src/package.lisp | 12 +++++++++- src/program-events.lisp | 20 +++++++++++++++++ src/ui-goodies.lisp | 24 +++++++++++++++++++- 7 files changed, 140 insertions(+), 11 deletions(-) diff --git a/etc/init.lisp b/etc/init.lisp index ff1103a..cb7c0cf 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -208,6 +208,8 @@ (define-key "C-t u" #'update-current-timeline *thread-keymap*) +(define-key "C-t U" #'update-current-timeline-backwards *thread-keymap*) + (define-key "C-t h r" #'refresh-tags *thread-keymap*) (define-key "C-X m t" #'move-message-tree *thread-keymap*) diff --git a/etc/next-previous-open.lisp b/etc/next-previous-open.lisp index 969a5e3..4d75206 100644 --- a/etc/next-previous-open.lisp +++ b/etc/next-previous-open.lisp @@ -10,6 +10,18 @@ (ui:thread-go-up) (ui:thread-open-selected-message)) -(define-key "right" #'open-next *thread-keymap*) +(defun delete-and-move-next () + (ui:thread-mark-delete-selected-message) + (ui:thread-open-selected-message)) -(define-key "left" #'open-previous *thread-keymap*) +(defun delete-and-move-previous () + (ui:thread-mark-delete-selected-message) + (ui:thread-open-selected-message)) + +(define-key "right" #'open-next *thread-keymap*) + +(define-key "left" #'open-previous *thread-keymap*) + +(define-key "M-d" #'delete-and-move-next *thread-keymap*) + +(define-key "M-u" #'delete-and-move-previous *thread-keymap*) diff --git a/src/api-client.lisp b/src/api-client.lisp index bf43478..4f4408d 100644 --- a/src/api-client.lisp +++ b/src/api-client.lisp @@ -276,12 +276,27 @@ authorizations was performed with success." :min-id min-id :limit limit)) +(defun status-id< (a b) + (string< (tooter:id a) + (tooter:id b))) + +(defun update-pagination-statuses-so-far (statuses timeline folder) + (loop for status in statuses do + (let ((add-fetched-event (make-instance 'program-events:add-pagination-status-event + :status-id (tooter:id status) + :timeline timeline + :folder folder))) + (program-events:push-event add-fetched-event)))) + (defun-w-lock update-timeline (timeline kind folder &key - local only-media max-id since-id - min-id - (limit 20)) + local + only-media + max-id + since-id + min-id + (limit 20)) *client-lock* "Update a timeline, this function will fetch new messages and generate and event to update the program reflectings the changes in the timeline (saves @@ -301,11 +316,18 @@ authorizations was performed with success." :folder folder :localp local :min-id min-id))) + + ;; note that, because events are enqueued with priority and the + ;; first instanced event has better priority the another instanced + ;; later, the events generated by the function below will run + ;; after the update-timeline-event; in this case it does not + ;; matter, though + (update-pagination-statuses-so-far timeline-statuses timeline folder) (program-events:push-event event))) (defun-w-lock get-timeline-tag (tag &key min-id (limit 20)) *client-lock* - "Gets messages that contains tags identitgied by parameter `tag'" + "Gets messages that contains tags identified by parameter `tag'" (tooter:timeline-tag *client* tag :local nil @@ -374,7 +396,7 @@ database." (tooter:find-status *client* status-id))) (defun-w-lock get-status-context (status-id) *client-lock* - "Get aparent and a child of a status (identified by status-id), if exists" + "Get a parent and a child of a status (identified by status-id), if exists" (tooter:context *client* status-id)) (defun-w-lock send-status (content in-reply-to-id attachments subject visibility) diff --git a/src/db.lisp b/src/db.lisp index 67be63d..1a008a3 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -89,6 +89,9 @@ (define-constant +table-ignored-status+ :ignored-status :test #'eq) +(define-constant +table-pagination-status+ :pagination-status + :test #'eq) + (define-constant +table-followed-user+ :followed-user :test #'eq) @@ -405,6 +408,13 @@ " \"created-at\" TEXT NOT NULL" +make-close+))) +(defun make-pagination-status () + (query-low-level (strcat (prepare-table +table-pagination-status+ :autoincrementp t) + " \"status-id\" TEXT NOT NULL, " + " timeline TEXT NOT NULL, " + " folder TEXT NOT NULL " + +make-close+))) + (defun build-all-indices () (create-table-index +table-status+ '(:folder :timeline :status-id)) (create-table-index +table-account+ '(:id :acct)) @@ -455,6 +465,7 @@ (make-subscribed-tag) (make-tag-histogram) (make-conversation) + (make-pagination-status) (build-all-indices) (fs:set-file-permissions (db-path) (logior fs:+s-irusr+ fs:+s-iwusr+)))) @@ -1697,13 +1708,43 @@ to `timeline' , `folder' and possibly `account-id', older than (when-let ((row (fetch-single query))) (second row)))) -(defun last-status-id-timeline-folder (timeline folder) +(defun last-status-id-timeline-folder-table (timeline folder table) (let ((query (select ((:as (fields (:max :status-id)) :max)) - (from :status) + (from table) (where (:and (:= :timeline timeline) (:= :folder folder)))))) (second (fetch-single query)))) +(defun first-status-id-timeline-folder-table (timeline folder table) + (let ((query (select ((:as (fields (:min :status-id)) :min)) + (from table) + (where (:and (:= :timeline timeline) + (:= :folder folder)))))) + (second (fetch-single query)))) + +(defun last-status-id-timeline-folder (timeline folder) + (last-status-id-timeline-folder-table timeline folder :status)) + +(defun first-status-id-timeline-folder (timeline folder) + (first-status-id-timeline-folder-table timeline folder :status)) + +(defun last-ignored-status-id-timeline-folder (timeline folder) + (last-status-id-timeline-folder-table timeline folder :ignored-status)) + +(defun first-ignored-status-id-timeline-folder (timeline folder) + (first-status-id-timeline-folder-table timeline folder :ignored-status)) + +(defun last-pagination-status-id-timeline-folder (timeline folder) + (last-status-id-timeline-folder-table timeline folder :pagination-status)) + +(defun first-pagination-status-id-timeline-folder (timeline folder) + (first-status-id-timeline-folder-table timeline folder :pagination-status)) + +(defun add-to-pagination-status (status-id folder timeline) + (query (make-insert +table-pagination-status+ + (:status-id :folder :timeline) + (status-id folder timeline)))) + (defun delete-status (timeline-type folder status-id) "delete status and connect its children with their grandparent" (let* ((status (find-status-id-folder-timeline status-id diff --git a/src/package.lisp b/src/package.lisp index 308865f..e666fef 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -786,6 +786,12 @@ :search-next-unread-message :last-message-index-status :last-status-id-timeline-folder + :first-status-id-timeline-folder + :last-ignored-status-id-timeline-folder + :first-ignored-status-id-timeline-folder + :last-pagination-status-id-timeline-folder + :first-pagination-status-id-timeline-folder + :add-to-pagination-status :count-status-marked-to-delete :delete-all-statuses-marked-deleted :tags-histogram-foreground @@ -1119,7 +1125,10 @@ :report-status-event :add-crypto-data-event :function-event - :dispatch-program-events)) + :dispatch-program-events + :add-pagination-status-event + :status-id + :timeline)) (defpackage :api-client (:use @@ -1821,6 +1830,7 @@ :change-folder :change-timeline :update-current-timeline + :update-current-timeline-backwards :refresh-tags :favourite-selected-status :unfavourite-selected-status diff --git a/src/program-events.lisp b/src/program-events.lisp index e909b9d..40aea81 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -762,6 +762,26 @@ (db:import-crypto-data (db:acct->id username) key))) +(defclass add-pagination-status-event (program-event) + ((status-id + :initform nil + :initarg :status-id + :accessor status-id) + (timeline + :initform nil + :initarg :timeline + :accessor timeline) + (folder + :initform nil + :initarg :folder + :accessor folder))) + +(defmethod process-event ((object add-pagination-status-event)) + (with-accessors ((status-id status-id) + (timeline timeline) + (folder folder)) object + (db:add-to-pagination-status status-id folder timeline))) + (defclass function-event (program-event) ()) (defmethod process-event ((object function-event)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index fd1deef..e6983df 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -470,7 +470,7 @@ and if fetch local (again, to server) statuses only." "Update current timeline" (let* ((timeline (thread-window:timeline-type specials:*thread-window*)) (folder (thread-window:timeline-folder specials:*thread-window*)) - (max-id (db:last-status-id-timeline-folder timeline folder))) + (max-id (db:last-pagination-status-id-timeline-folder timeline folder))) (multiple-value-bind (kind localp) (timeline->kind timeline) (flet ((update () @@ -486,6 +486,28 @@ and if fetch local (again, to server) statuses only." :ending-message (_ "Messages downloaded.") :life-start (* (swconf:config-notification-life) 5)))))) +(defun update-current-timeline-backwards () + "Update current timeline backwards + +Starting from the oldest toot and going back." + (let* ((timeline (thread-window:timeline-type specials:*thread-window*)) + (folder (thread-window:timeline-folder specials:*thread-window*)) + (min-id (db:first-pagination-status-id-timeline-folder timeline folder))) + (multiple-value-bind (kind localp) + (timeline->kind timeline) + (flet ((update () + (client:update-timeline timeline + kind + folder + :max-id min-id + :local localp) + (let ((refresh-event (make-instance 'refresh-thread-windows-event))) + (push-event refresh-event)))) + (notify-procedure #'update + (_ "Downloading messages.") + :ending-message (_ "Messages downloaded.") + :life-start (* (swconf:config-notification-life) 5)))))) + (defun refresh-tags () "Update messages for subscribed tags" (let ((all-tags (db:all-subscribed-tags-name)))