mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-25 09:17:45 +01:00
- added a command to show the parent of a post.
This commit is contained in:
parent
623739f29d
commit
f90d7be418
@ -337,6 +337,8 @@
|
|||||||
|
|
||||||
(define-key "P" #'poll-vote *thread-keymap*)
|
(define-key "P" #'poll-vote *thread-keymap*)
|
||||||
|
|
||||||
|
(define-key "p" #'show-parent-message *thread-keymap*)
|
||||||
|
|
||||||
(define-key "U" #'thread-mark-prevent-delete-selected-message *thread-keymap*)
|
(define-key "U" #'thread-mark-prevent-delete-selected-message *thread-keymap*)
|
||||||
|
|
||||||
(define-key "X" #'refresh-thread-totally *thread-keymap*)
|
(define-key "X" #'refresh-thread-totally *thread-keymap*)
|
||||||
|
32
src/db.lisp
32
src/db.lisp
@ -1643,9 +1643,9 @@ that status id is not a unique identifier despite the name."
|
|||||||
Note that the tuple (`status-id', `folder' and `timeline') is the only key
|
Note that the tuple (`status-id', `folder' and `timeline') is the only key
|
||||||
that identify a single message in table :status"
|
that identify a single message in table :status"
|
||||||
(fetch-single (select :* (from +table-status+)
|
(fetch-single (select :* (from +table-status+)
|
||||||
(where (:and (:= :status-id status-id)
|
(where (:and (:= :status-id status-id)
|
||||||
(:= :timeline timeline)
|
(:= :timeline timeline)
|
||||||
(:= :folder folder))))))
|
(:= :folder folder))))))
|
||||||
|
|
||||||
(defmacro gen-message-select ()
|
(defmacro gen-message-select ()
|
||||||
"Convenience macro for `make-filtered-message-select'"
|
"Convenience macro for `make-filtered-message-select'"
|
||||||
@ -2008,10 +2008,11 @@ to `timeline' and `folder'"
|
|||||||
(labels ((tree= (a b)
|
(labels ((tree= (a b)
|
||||||
(message-tree-root-equal a b)))
|
(message-tree-root-equal a b)))
|
||||||
(let ((res ())
|
(let ((res ())
|
||||||
(status-ids (mapcar #'second (fetch-all-rows (select :status-id
|
(status-ids (mapcar #'second
|
||||||
(from :status)
|
(fetch-all-rows (select :status-id
|
||||||
(where (:folder folder))
|
(from :status)
|
||||||
(order-by (:asc :status-id)))))))
|
(where (:folder folder))
|
||||||
|
(order-by (:asc :status-id)))))))
|
||||||
(loop for status-id in status-ids do
|
(loop for status-id in status-ids do
|
||||||
(let* ((status-id-root (row-message-status-id (message-root timeline
|
(let* ((status-id-root (row-message-status-id (message-root timeline
|
||||||
folder
|
folder
|
||||||
@ -2786,8 +2787,8 @@ nil if no such message exists"
|
|||||||
last-status-id))))))
|
last-status-id))))))
|
||||||
|
|
||||||
(defun all-tags-with-new-message-fetched ()
|
(defun all-tags-with-new-message-fetched ()
|
||||||
"Returns the most recent messages fetched that contains subscribed tags, or
|
"Returns a list all the tags names that contains new messages, or nil
|
||||||
nil if no such messages exist"
|
if no such messages exist"
|
||||||
(remove-if-not #'more-recent-tag-fetched-p
|
(remove-if-not #'more-recent-tag-fetched-p
|
||||||
(all-subscribed-tags-name)))
|
(all-subscribed-tags-name)))
|
||||||
|
|
||||||
@ -3371,3 +3372,16 @@ days in the past"
|
|||||||
|
|
||||||
(defun gempub-metadata-find (local-uri)
|
(defun gempub-metadata-find (local-uri)
|
||||||
(fetch-single (select :* (from +table-gempub-metadata+) (where (:= :local-uri local-uri)))))
|
(fetch-single (select :* (from +table-gempub-metadata+) (where (:= :local-uri local-uri)))))
|
||||||
|
|
||||||
|
(defun get-parent-status-row (status-id)
|
||||||
|
"Get the database row of representing the parent status of the status
|
||||||
|
identified by `status-id', if exists.
|
||||||
|
Note: `status-id' must identify at least a row in the database."
|
||||||
|
(flet ((get-cache (status-id)
|
||||||
|
(db:find-status-id status-id)))
|
||||||
|
(when-let* ((cached-child (get-cache status-id))
|
||||||
|
(parent-id (db:row-message-reply-to-id cached-child)))
|
||||||
|
(or (get-cache parent-id)
|
||||||
|
(progn
|
||||||
|
(db:update-db (api-client:get-remote-status parent-id))
|
||||||
|
(get-cache parent-id))))))
|
||||||
|
@ -1145,7 +1145,8 @@
|
|||||||
:gempub-metadata-add
|
:gempub-metadata-add
|
||||||
:all-gempub-metadata
|
:all-gempub-metadata
|
||||||
:gempub-metadata-delete
|
:gempub-metadata-delete
|
||||||
:gempub-metadata-find))
|
:gempub-metadata-find
|
||||||
|
:get-parent-status-row))
|
||||||
|
|
||||||
(defpackage :date-formatter
|
(defpackage :date-formatter
|
||||||
(:use
|
(:use
|
||||||
@ -3169,7 +3170,8 @@
|
|||||||
:clear-cache
|
:clear-cache
|
||||||
:print-mentions
|
:print-mentions
|
||||||
:delete-notifications
|
:delete-notifications
|
||||||
:show-announcements))
|
:show-announcements
|
||||||
|
:show-parent-message))
|
||||||
|
|
||||||
(defpackage :scheduled-events
|
(defpackage :scheduled-events
|
||||||
(:use
|
(:use
|
||||||
|
@ -3489,3 +3489,19 @@ gemini client certificates!)."
|
|||||||
"Show an informative window about instance's announcements"
|
"Show an informative window about instance's announcements"
|
||||||
(info-message (_ "Getting all announcements, please wait…"))
|
(info-message (_ "Getting all announcements, please wait…"))
|
||||||
(push-event (make-instance 'show-announcements-event)))
|
(push-event (make-instance 'show-announcements-event)))
|
||||||
|
|
||||||
|
(defun show-parent-message ()
|
||||||
|
(when-let* ((selected-row (line-oriented-window:selected-row-fields *thread-window*))
|
||||||
|
(new-window-width (truncate (* (windows:win-width *main-window*) 2/3)))
|
||||||
|
(status-id (actual-author-message-id selected-row))
|
||||||
|
(parent-row (db:get-parent-status-row status-id))
|
||||||
|
(words (split-words (db:row-message-rendered-text parent-row)))
|
||||||
|
(lines (flush-left-mono-text words new-window-width))
|
||||||
|
(bg (swconf:win-bg swconf:+key-help-dialog+))
|
||||||
|
(fg (swconf:win-fg swconf:+key-help-dialog+)))
|
||||||
|
(windows:make-blocking-message-dialog *main-window*
|
||||||
|
nil
|
||||||
|
(_ "Parent message")
|
||||||
|
lines
|
||||||
|
bg
|
||||||
|
fg)))
|
||||||
|
Loading…
x
Reference in New Issue
Block a user