From 6c45270877bad5f19ddb3301567775e9636e067a Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 16 Jul 2023 13:59:36 +0200 Subject: [PATCH] - added 'reply to' field to post's header. --- src/db.lisp | 5 ++- src/message-rendering-utils.lisp | 55 +++++++++++++++++++------------- src/package.lisp | 1 + src/thread-window.lisp | 12 +++---- 4 files changed, 44 insertions(+), 29 deletions(-) diff --git a/src/db.lisp b/src/db.lisp index 81d12bc..c26581d 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -1787,7 +1787,8 @@ forms a messages thread" (local-name-prefix "") (acct-prefix "")) "Given a tuple that identify a message (`timeline' `folder' `status-id'), -returns an alist of (local-username . acct)." +returns an alist of (local-username . acct) of all the ancestors of +the message identified by the tuple." (let ((all-messages (mtree:collect-nodes-data (message-id->tree timeline folder status-id))) (results ())) (loop for message in all-messages do @@ -1848,6 +1849,8 @@ row." (gen-access-message-row message-creation-time :created-at) +(gen-access-message-row message-reply-to-account-id :in-reply-to-account-id) + (gen-access-message-row message-subject :spoiler-text) (gen-access-message-row message-tags :tags) diff --git a/src/message-rendering-utils.lisp b/src/message-rendering-utils.lisp index df1bd21..6ddd86a 100644 --- a/src/message-rendering-utils.lisp +++ b/src/message-rendering-utils.lisp @@ -230,26 +230,31 @@ :only-empty-or-0-are-null t))) (defun message-original->text-header (message-row) - (let* ((date-format (swconf:date-fmt swconf:+key-message-window+)) - (username (db:row-message-username message-row)) - (display-name (db:row-message-user-display-name message-row)) - (creation-time (db:row-message-creation-time message-row)) - (visibility (visibility->mark (db:row-message-visibility message-row))) - (lockedp (db-utils:db-not-nil-p (db:row-lockedp message-row))) - (locked-mark (swconf:message-window-account-locking-status-mark lockedp)) - (encoded-date (db-utils:encode-datetime-string creation-time)) - (from-label (_ "From: ")) - (boosted-label (_ "Boosted: ")) - (visibility-label (_ "Visibility: ")) - (boosted-id (db:row-message-reblog-id message-row)) - (boosted-username (and boosted-id - (db:status-id->username boosted-id))) - (date-label (_ "Date: ")) - (padding-length (max (length from-label) - (length date-label) - (length boosted-label) - (length visibility-label))) - (text (misc:make-fresh-array 0 #\Space 'character nil))) + (let* ((date-format (swconf:date-fmt swconf:+key-message-window+)) + (username (db:row-message-username message-row)) + (display-name (db:row-message-user-display-name message-row)) + (creation-time (db:row-message-creation-time message-row)) + (visibility (visibility->mark (db:row-message-visibility message-row))) + (lockedp (db-utils:db-not-nil-p (db:row-lockedp message-row))) + (locked-mark (swconf:message-window-account-locking-status-mark lockedp)) + (encoded-date (db-utils:encode-datetime-string creation-time)) + (parent-author-id (db:row-message-reply-to-account-id message-row)) + (parent-author (when parent-author-id + (db:user-id->username parent-author-id))) + (in-reply-to-label (_ "In reply of: ")) + (from-label (_ "From: ")) + (boosted-label (_ "Boosted: ")) + (visibility-label (_ "Visibility: ")) + (boosted-id (db:row-message-reblog-id message-row)) + (boosted-username (and boosted-id + (db:status-id->username boosted-id))) + (date-label (_ "Date: ")) + (padding-length (max (length from-label) + (length date-label) + (length boosted-label) + (length visibility-label) + (length in-reply-to-label))) + (text (misc:make-fresh-array 0 #\Space 'character nil))) (with-output-to-string (stream text) (format stream "~a(~a) ~a~a~%" @@ -260,13 +265,19 @@ (right-padding date-label padding-length) (format-time encoded-date date-format)) (format stream - "~a~a~2%" + "~a~a~%" (right-padding visibility-label padding-length) visibility) + (when parent-author + (format stream + "~a~a~%" + (right-padding in-reply-to-label padding-length) + parent-author)) (when boosted-id (format stream "~a~a~%" (right-padding boosted-label padding-length) - boosted-username))) + boosted-username)) + (format stream "~%")) text)) (defun poll->text (poll-id width) diff --git a/src/package.lisp b/src/package.lisp index 6a63a0e..a1a0e22 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -949,6 +949,7 @@ :row-message-content :row-message-rendered-text :row-message-creation-time + :row-message-reply-to-account-id :row-message-subject :row-message-tags :row-message-reblog-id diff --git a/src/thread-window.lisp b/src/thread-window.lisp index e653d4f..1f7f29b 100644 --- a/src/thread-window.lisp +++ b/src/thread-window.lisp @@ -853,17 +853,17 @@ db:renumber-timeline-message-index." (timeline-type timeline-type) (timeline-folder timeline-folder)) object (a:when-let* ((selected-row (selected-row object)) - (fields (fields selected-row)) - (original (db-utils:db-getf fields :content :default "")) - (status-id (db:row-message-status-id fields)) - (header (message-original->text-header fields))) + (fields (fields selected-row)) + (original (db-utils:db-getf fields :content :default "")) + (status-id (db:row-message-status-id fields)) + (header (message-original->text-header fields))) (let* ((body (db:row-message-rendered-text fields)) (attachments (status-attachments->text status-id)) (refresh-event (make-instance 'program-events:refresh-conversations-window-event)) (poll (db:find-poll-bound-to-status status-id)) (poll-text (poll->text (db:row-id poll) - (truncate (/ (win-width-no-border object) - 2))))) + (truncate (/ (win-width-no-border object) + 2))))) (multiple-value-bind (reblogged-status-body reblogged-status-attachments) (reblogged-data fields) (let ((actual-body (if (string= body reblogged-status-body)