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

- removed dependency to 'cl-syntax'; 

- added subject and language headers to statuses printed in the message window.
This commit is contained in:
cage 2023-11-03 14:12:03 +01:00
parent 1e88fe5805
commit 29820b4398
3 changed files with 24 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/db.lisp
View File

@ -1849,6 +1849,8 @@ row."
(gen-access-message-row message-creation-time :created-at)
(gen-access-message-row language :language)
(gen-access-message-row message-reply-to-account-id :in-reply-to-account-id)
(gen-access-message-row message-subject :spoiler-text)
@ -1927,8 +1929,6 @@ row."
(gen-access-message-row author :author)
(gen-access-message-row language :language)
(gen-access-message-row charset :charset)
(gen-access-message-row published :published)

2
src/gui/client/gui-goodies.lisp
View File

@ -1,6 +1,6 @@
(in-package :gui-goodies)
(cl-syntax:use-syntax 'gui-utils:nodgui-color-syntax)
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
(defparameter *toplevel* gui:*tk*)

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

@ -89,7 +89,7 @@
(let ((destination-user-id (crypto-message-destination-user message-data)))
(if (null destination-user-id)
(when notify-cant-crypt
(ui:notify (_ "This message will *not* be crypted")))
(ui:notify (_ "This message will *not* be encrypted")))
(let* ((destination-username (db:user-id->username destination-user-id))
(destination-mention (msg-utils:add-mention-prefix destination-username))
(new-body (misc:make-fresh-array 0 #\Space 'character nil))
@ -97,7 +97,7 @@
(if (null crypto-key)
(when notify-cant-crypt
(ui:notify (format nil
(_ "No key to crypt message for ~s found")
(_ "No key to encrypt message for ~s found")
destination-username)))
(with-output-to-string (body-stream new-body)
;; add username on top
@ -238,10 +238,12 @@
(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))
(subject (db:row-message-subject 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))
(language (db:row-language message-row))
(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)))
@ -249,6 +251,8 @@
(from-label (_ "From: "))
(boosted-label (_ "Boosted: "))
(visibility-label (_ "Visibility: "))
(language-label (_ "Language: "))
(subject-label (_ "Subject:" ))
(boosted-id (db:row-message-reblog-id message-row))
(boosted-username (and boosted-id
(db:status-id->username boosted-id)))
@ -257,7 +261,9 @@
(length date-label)
(length boosted-label)
(length visibility-label)
(length in-reply-to-label)))
(length in-reply-to-label)
(length subject-label)
(length language-label)))
(text (misc:make-fresh-array 0 #\Space 'character nil)))
(with-output-to-string (stream text)
(format stream
@ -274,14 +280,22 @@
visibility)
(when parent-author
(format stream
"~%~a~a~%"
"~a~a~%"
(right-padding in-reply-to-label padding-length)
parent-author))
(when language
(format stream "~a~a~%"
(right-padding language-label padding-length)
language))
(when subject
(format stream "~a~a~%"
(right-padding subject-label padding-length)
subject))
(format stream "~%")
(when boosted-id
(format stream "~%~a~a~%"
(format stream "~a~a~%"
(right-padding boosted-label padding-length)
boosted-username))
(format stream "~%"))
boosted-username)))
text))
(defun poll->text (poll-id width)