From f90d7be41821a47f24226594baa3751a0c8c7ba9 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 15 Oct 2023 13:55:30 +0200 Subject: [PATCH] - added a command to show the parent of a post. --- etc/init.lisp | 2 ++ src/db.lisp | 32 +++++++++++++++++++++++--------- src/package.lisp | 6 ++++-- src/ui-goodies.lisp | 16 ++++++++++++++++ 4 files changed, 45 insertions(+), 11 deletions(-) diff --git a/etc/init.lisp b/etc/init.lisp index 7f75491..b41f0ed 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -337,6 +337,8 @@ (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 "X" #'refresh-thread-totally *thread-keymap*) diff --git a/src/db.lisp b/src/db.lisp index 8e9162d..bd00264 100644 --- a/src/db.lisp +++ b/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 that identify a single message in table :status" (fetch-single (select :* (from +table-status+) - (where (:and (:= :status-id status-id) - (:= :timeline timeline) - (:= :folder folder)))))) + (where (:and (:= :status-id status-id) + (:= :timeline timeline) + (:= :folder folder)))))) (defmacro gen-message-select () "Convenience macro for `make-filtered-message-select'" @@ -2008,10 +2008,11 @@ to `timeline' and `folder'" (labels ((tree= (a b) (message-tree-root-equal a b))) (let ((res ()) - (status-ids (mapcar #'second (fetch-all-rows (select :status-id - (from :status) - (where (:folder folder)) - (order-by (:asc :status-id))))))) + (status-ids (mapcar #'second + (fetch-all-rows (select :status-id + (from :status) + (where (:folder folder)) + (order-by (:asc :status-id))))))) (loop for status-id in status-ids do (let* ((status-id-root (row-message-status-id (message-root timeline folder @@ -2786,8 +2787,8 @@ nil if no such message exists" last-status-id)))))) (defun all-tags-with-new-message-fetched () - "Returns the most recent messages fetched that contains subscribed tags, or -nil if no such messages exist" + "Returns a list all the tags names that contains new messages, or nil +if no such messages exist" (remove-if-not #'more-recent-tag-fetched-p (all-subscribed-tags-name))) @@ -3371,3 +3372,16 @@ days in the past" (defun gempub-metadata-find (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)))))) diff --git a/src/package.lisp b/src/package.lisp index 05c6720..a194703 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1145,7 +1145,8 @@ :gempub-metadata-add :all-gempub-metadata :gempub-metadata-delete - :gempub-metadata-find)) + :gempub-metadata-find + :get-parent-status-row)) (defpackage :date-formatter (:use @@ -3169,7 +3170,8 @@ :clear-cache :print-mentions :delete-notifications - :show-announcements)) + :show-announcements + :show-parent-message)) (defpackage :scheduled-events (:use diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 7e2da94..853fb3d 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -3489,3 +3489,19 @@ gemini client certificates!)." "Show an informative window about instance's announcements" (info-message (_ "Getting all announcements, please wait…")) (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)))