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

- 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.
This commit is contained in:
cage 2020-05-14 16:32:01 +02:00
parent 9a5509eabe
commit 5f00107808
7 changed files with 140 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/init.lisp
View File

@ -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*)

16
etc/next-previous-open.lisp
View File

@ -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*)

32
src/api-client.lisp
View File

@ -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)

45
src/db.lisp
View File

@ -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

12
src/package.lisp
View File

@ -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

20
src/program-events.lisp
View File

@ -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))

24
src/ui-goodies.lisp
View File

@ -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)))