From f90d7be41821a47f24226594baa3751a0c8c7ba9 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
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)))