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

- added 'reply to' field to post's header.

This commit is contained in:
cage 2023-07-16 13:59:36 +02:00
parent 2ed46879cf
commit 6c45270877
4 changed files with 44 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/db.lisp
View File

@ -1787,7 +1787,8 @@ forms a messages thread"
(local-name-prefix "") (local-name-prefix "")
(acct-prefix "")) (acct-prefix ""))
"Given a tuple that identify a message (`timeline' `folder' `status-id'), "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))) (let ((all-messages (mtree:collect-nodes-data (message-id->tree timeline folder status-id)))
(results ())) (results ()))
(loop for message in all-messages do (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-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-subject :spoiler-text)
(gen-access-message-row message-tags :tags) (gen-access-message-row message-tags :tags)

55
src/message-rendering-utils.lisp
View File

@ -230,26 +230,31 @@
:only-empty-or-0-are-null t))) :only-empty-or-0-are-null t)))
(defun message-original->text-header (message-row) (defun message-original->text-header (message-row)
(let* ((date-format (swconf:date-fmt swconf:+key-message-window+)) (let* ((date-format (swconf:date-fmt swconf:+key-message-window+))
(username (db:row-message-username message-row)) (username (db:row-message-username message-row))
(display-name (db:row-message-user-display-name message-row)) (display-name (db:row-message-user-display-name message-row))
(creation-time (db:row-message-creation-time message-row)) (creation-time (db:row-message-creation-time message-row))
(visibility (visibility->mark (db:row-message-visibility message-row))) (visibility (visibility->mark (db:row-message-visibility message-row)))
(lockedp (db-utils:db-not-nil-p (db:row-lockedp message-row))) (lockedp (db-utils:db-not-nil-p (db:row-lockedp message-row)))
(locked-mark (swconf:message-window-account-locking-status-mark lockedp)) (locked-mark (swconf:message-window-account-locking-status-mark lockedp))
(encoded-date (db-utils:encode-datetime-string creation-time)) (encoded-date (db-utils:encode-datetime-string creation-time))
(from-label (_ "From: ")) (parent-author-id (db:row-message-reply-to-account-id message-row))
(boosted-label (_ "Boosted: ")) (parent-author (when parent-author-id
(visibility-label (_ "Visibility: ")) (db:user-id->username parent-author-id)))
(boosted-id (db:row-message-reblog-id message-row)) (in-reply-to-label (_ "In reply of: "))
(boosted-username (and boosted-id (from-label (_ "From: "))
(db:status-id->username boosted-id))) (boosted-label (_ "Boosted: "))
(date-label (_ "Date: ")) (visibility-label (_ "Visibility: "))
(padding-length (max (length from-label) (boosted-id (db:row-message-reblog-id message-row))
(length date-label) (boosted-username (and boosted-id
(length boosted-label) (db:status-id->username boosted-id)))
(length visibility-label))) (date-label (_ "Date: "))
(text (misc:make-fresh-array 0 #\Space 'character nil))) (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) (with-output-to-string (stream text)
(format stream (format stream
"~a(~a) ~a~a~%" "~a(~a) ~a~a~%"
@ -260,13 +265,19 @@
(right-padding date-label padding-length) (right-padding date-label padding-length)
(format-time encoded-date date-format)) (format-time encoded-date date-format))
(format stream (format stream
"~a~a~2%" "~a~a~%"
(right-padding visibility-label padding-length) (right-padding visibility-label padding-length)
visibility) visibility)
(when parent-author
(format stream
"~a~a~%"
(right-padding in-reply-to-label padding-length)
parent-author))
(when boosted-id (when boosted-id
(format stream "~a~a~%" (format stream "~a~a~%"
(right-padding boosted-label padding-length) (right-padding boosted-label padding-length)
boosted-username))) boosted-username))
(format stream "~%"))
text)) text))
(defun poll->text (poll-id width) (defun poll->text (poll-id width)

1
src/package.lisp
View File

@ -949,6 +949,7 @@
:row-message-content :row-message-content
:row-message-rendered-text :row-message-rendered-text
:row-message-creation-time :row-message-creation-time
:row-message-reply-to-account-id
:row-message-subject :row-message-subject
:row-message-tags :row-message-tags
:row-message-reblog-id :row-message-reblog-id

12
src/thread-window.lisp
View File

@ -853,17 +853,17 @@ db:renumber-timeline-message-index."
(timeline-type timeline-type) (timeline-type timeline-type)
(timeline-folder timeline-folder)) object (timeline-folder timeline-folder)) object
(a:when-let* ((selected-row (selected-row object)) (a:when-let* ((selected-row (selected-row object))
(fields (fields selected-row)) (fields (fields selected-row))
(original (db-utils:db-getf fields :content :default "")) (original (db-utils:db-getf fields :content :default ""))
(status-id (db:row-message-status-id fields)) (status-id (db:row-message-status-id fields))
(header (message-original->text-header fields))) (header (message-original->text-header fields)))
(let* ((body (db:row-message-rendered-text fields)) (let* ((body (db:row-message-rendered-text fields))
(attachments (status-attachments->text status-id)) (attachments (status-attachments->text status-id))
(refresh-event (make-instance 'program-events:refresh-conversations-window-event)) (refresh-event (make-instance 'program-events:refresh-conversations-window-event))
(poll (db:find-poll-bound-to-status status-id)) (poll (db:find-poll-bound-to-status status-id))
(poll-text (poll->text (db:row-id poll) (poll-text (poll->text (db:row-id poll)
(truncate (/ (win-width-no-border object) (truncate (/ (win-width-no-border object)
2))))) 2)))))
(multiple-value-bind (reblogged-status-body reblogged-status-attachments) (multiple-value-bind (reblogged-status-body reblogged-status-attachments)
(reblogged-data fields) (reblogged-data fields)
(let ((actual-body (if (string= body reblogged-status-body) (let ((actual-body (if (string= body reblogged-status-body)