mirror of https://codeberg.org/cage/tinmop/
- added rendering of polls.
This commit is contained in:
cage
parent
d33af4ecbe
commit
ab50276605
|
|
@ -37,7 +37,13 @@ main-window.foreground = white
|
|||
|
||||
crypted.mark.value = " 🔏👌"
|
||||
|
||||
# the character used to draw the vote's horizontal histogram
|
||||
# note: keeps it one character wide
|
||||
|
||||
vote-vertical-bar = "⯀"
|
||||
|
||||
# quick help window style
|
||||
|
||||
quick-help.header.foreground = white
|
||||
|
||||
quick-help.header.background = red
|
||||
|
|
|
|||
|
|
@ -72,3 +72,7 @@ color-regexp = "\*[^*]+\*" #ffff00 bold
|
|||
color-regexp = "_[^_]+_" #ffff00 underline
|
||||
|
||||
color-regexp = "/[^/]+/" #ffff00 italic
|
||||
|
||||
color-regexp = "⯀" green bold
|
||||
|
||||
color-regexp = "The poll has expired" #ff00ff bold
|
||||
28
po/it.po
28
po/it.po
|
|
@ -8,8 +8,8 @@ msgid ""
|
|||
msgstr ""
|
||||
"Project-Id-Version: tinmop 0.0.1\n"
|
||||
"Report-Msgid-Bugs-To: https://notabug.org/cage/tinmop/\n"
|
||||
"POT-Creation-Date: 2020-05-30 12:00+0200\n"
|
||||
"PO-Revision-Date: 2020-05-30 12:03+0200\n"
|
||||
"POT-Creation-Date: 2020-05-31 12:44+0200\n"
|
||||
"PO-Revision-Date: 2020-05-31 12:46+0200\n"
|
||||
"Last-Translator: cage <cage@invalid.org>\n"
|
||||
"Language-Team: Italian\n"
|
||||
"Language: it\n"
|
||||
|
|
@ -131,7 +131,7 @@ msgstr "Notifica i messaggi che menzionano l'utente."
|
|||
msgid "Error: command ~a not found"
|
||||
msgstr "Errore: comando ~a non trovato"
|
||||
|
||||
#: src/conditions.lisp:67 src/conditions.lisp:71 src/db.lisp:2217
|
||||
#: src/conditions.lisp:67 src/conditions.lisp:71 src/db.lisp:2354
|
||||
#: src/message-rendering-utils.lisp:132 src/message-rendering-utils.lisp:166
|
||||
#: src/message-rendering-utils.lisp:171
|
||||
msgid "unknown"
|
||||
|
|
@ -141,19 +141,19 @@ msgstr "sconosciuto"
|
|||
msgid "Conversations"
|
||||
msgstr "Conversazioni"
|
||||
|
||||
#: src/db.lisp:164
|
||||
#: src/db.lisp:170
|
||||
msgid "federated"
|
||||
msgstr "federata"
|
||||
|
||||
#: src/db.lisp:166
|
||||
#: src/db.lisp:172
|
||||
msgid "local"
|
||||
msgstr "locale"
|
||||
|
||||
#: src/db.lisp:168
|
||||
#: src/db.lisp:174
|
||||
msgid "direct"
|
||||
msgstr "diretta"
|
||||
|
||||
#: src/db.lisp:170
|
||||
#: src/db.lisp:176
|
||||
msgid "home"
|
||||
msgstr "home"
|
||||
|
||||
|
|
@ -283,6 +283,10 @@ msgstr "Rilanciato per: "
|
|||
msgid "Date: "
|
||||
msgstr "Scritto il: "
|
||||
|
||||
#: src/message-rendering-utils.lisp:259
|
||||
msgid "The poll has expired"
|
||||
msgstr "Il sondaggio è scaduto"
|
||||
|
||||
#: src/message-window.lisp:218
|
||||
msgid "Messages"
|
||||
msgstr "Messaggi"
|
||||
|
|
@ -364,7 +368,7 @@ msgstr "Oggetto del messaggio: "
|
|||
msgid "Visibility:"
|
||||
msgstr "Visibilità:"
|
||||
|
||||
#: src/software-configuration.lisp:423
|
||||
#: src/software-configuration.lisp:429
|
||||
msgid "This message was crypted."
|
||||
msgstr "Questo messaggion era cifrato."
|
||||
|
||||
|
|
@ -406,21 +410,21 @@ msgstr "Oggetto mancante"
|
|||
msgid "No message with index ~a exists."
|
||||
msgstr "Nessun messaggio esiste alla posizione ~a."
|
||||
|
||||
#: src/thread-window.lisp:854 src/thread-window.lisp:888
|
||||
#: src/thread-window.lisp:859 src/thread-window.lisp:893
|
||||
#, lisp-format
|
||||
msgid "No next message that contains ~s exists."
|
||||
msgstr "Nessun messaggio successivo che contenga ~s esiste."
|
||||
|
||||
#: src/thread-window.lisp:860 src/thread-window.lisp:894
|
||||
#: src/thread-window.lisp:865 src/thread-window.lisp:899
|
||||
#, lisp-format
|
||||
msgid "No previous message that contains ~s exists."
|
||||
msgstr "Nessun messaggio precedente che contenga ~s esiste."
|
||||
|
||||
#: src/thread-window.lisp:910
|
||||
#: src/thread-window.lisp:915
|
||||
msgid "No others unread messages exist."
|
||||
msgstr "Non ci sono altri messaggi non letti."
|
||||
|
||||
#: src/thread-window.lisp:921
|
||||
#: src/thread-window.lisp:926
|
||||
msgid "Threads"
|
||||
msgstr "Discussioni"
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ msgid ""
|
|||
msgstr ""
|
||||
"Project-Id-Version: tinmop 0.0.3\n"
|
||||
"Report-Msgid-Bugs-To: https://notabug.org/cage/tinmop/\n"
|
||||
"POT-Creation-Date: 2020-05-30 12:00+0200\n"
|
||||
"POT-Creation-Date: 2020-05-31 12:44+0200\n"
|
||||
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
|
||||
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
|
||||
"Language-Team: LANGUAGE <LL@li.org>\n"
|
||||
|
|
@ -127,7 +127,7 @@ msgstr ""
|
|||
msgid "Error: command ~a not found"
|
||||
msgstr ""
|
||||
|
||||
#: src/conditions.lisp:67 src/conditions.lisp:71 src/db.lisp:2217
|
||||
#: src/conditions.lisp:67 src/conditions.lisp:71 src/db.lisp:2354
|
||||
#: src/message-rendering-utils.lisp:132 src/message-rendering-utils.lisp:166
|
||||
#: src/message-rendering-utils.lisp:171
|
||||
msgid "unknown"
|
||||
|
|
@ -137,19 +137,19 @@ msgstr ""
|
|||
msgid "Conversations"
|
||||
msgstr ""
|
||||
|
||||
#: src/db.lisp:164
|
||||
#: src/db.lisp:170
|
||||
msgid "federated"
|
||||
msgstr ""
|
||||
|
||||
#: src/db.lisp:166
|
||||
#: src/db.lisp:172
|
||||
msgid "local"
|
||||
msgstr ""
|
||||
|
||||
#: src/db.lisp:168
|
||||
#: src/db.lisp:174
|
||||
msgid "direct"
|
||||
msgstr ""
|
||||
|
||||
#: src/db.lisp:170
|
||||
#: src/db.lisp:176
|
||||
msgid "home"
|
||||
msgstr ""
|
||||
|
||||
|
|
@ -276,6 +276,10 @@ msgstr ""
|
|||
msgid "Date: "
|
||||
msgstr ""
|
||||
|
||||
#: src/message-rendering-utils.lisp:259
|
||||
msgid "The poll has expired"
|
||||
msgstr ""
|
||||
|
||||
#: src/message-window.lisp:218
|
||||
msgid "Messages"
|
||||
msgstr ""
|
||||
|
|
@ -353,7 +357,7 @@ msgstr ""
|
|||
msgid "Visibility:"
|
||||
msgstr ""
|
||||
|
||||
#: src/software-configuration.lisp:423
|
||||
#: src/software-configuration.lisp:429
|
||||
msgid "This message was crypted."
|
||||
msgstr ""
|
||||
|
||||
|
|
@ -393,21 +397,21 @@ msgstr ""
|
|||
msgid "No message with index ~a exists."
|
||||
msgstr ""
|
||||
|
||||
#: src/thread-window.lisp:854 src/thread-window.lisp:888
|
||||
#: src/thread-window.lisp:859 src/thread-window.lisp:893
|
||||
#, lisp-format
|
||||
msgid "No next message that contains ~s exists."
|
||||
msgstr ""
|
||||
|
||||
#: src/thread-window.lisp:860 src/thread-window.lisp:894
|
||||
#: src/thread-window.lisp:865 src/thread-window.lisp:899
|
||||
#, lisp-format
|
||||
msgid "No previous message that contains ~s exists."
|
||||
msgstr ""
|
||||
|
||||
#: src/thread-window.lisp:910
|
||||
#: src/thread-window.lisp:915
|
||||
msgid "No others unread messages exist."
|
||||
msgstr ""
|
||||
|
||||
#: src/thread-window.lisp:921
|
||||
#: src/thread-window.lisp:926
|
||||
msgid "Threads"
|
||||
msgstr ""
|
||||
|
||||
|
|
|
|||
157
src/db.lisp
157
src/db.lisp
|
|
@ -80,6 +80,12 @@
|
|||
(define-constant +table-account+ :account
|
||||
:test #'eq)
|
||||
|
||||
(define-constant +table-poll-option+ :poll-option
|
||||
:test #'eq)
|
||||
|
||||
(define-constant +table-poll+ :poll
|
||||
:test #'eq)
|
||||
|
||||
(define-constant +table-attachment+ :attachment
|
||||
:test #'eq)
|
||||
|
||||
|
|
@ -328,6 +334,35 @@
|
|||
" \"created-at\" TEXT NOT NULL"
|
||||
+make-close+)))
|
||||
|
||||
(defun make-poll-option ()
|
||||
(query-low-level (strcat (prepare-table +table-poll-option+
|
||||
:autogenerated-id-p t
|
||||
:autoincrementp t)
|
||||
" \"poll-id\" TEXT NOT NULL "
|
||||
(make-foreign +table-poll+ "id" +cascade+ +cascade+) +col-sep+
|
||||
" title TEXT, "
|
||||
" \"votes-count\" INTEGER DEFAULT 0"
|
||||
+make-close+)))
|
||||
|
||||
(defun make-poll ()
|
||||
(query-low-level (strcat (prepare-table +table-poll+ :autogenerated-id-p t)
|
||||
" \"status-id\" TEXT NOT NULL "
|
||||
;(make-foreign +table-status+ "status-id" +cascade+ +cascade+)
|
||||
+col-sep+
|
||||
;; date
|
||||
" \"expire-date\" TEXT NOT NULL,"
|
||||
;; boolean
|
||||
" expired INTEGER DEFAULT 0 ,"
|
||||
;; boolean
|
||||
" multiple INTEGER DEFAULT 0 ,"
|
||||
" \"voters-count\" INTEGER DEFAULT 0 ,"
|
||||
" \"votes-count\" INTEGER DEFAULT 0 ,"
|
||||
;; boolean
|
||||
" \"voted\" INTEGER DEFAULT 0 ,"
|
||||
;; comma separated values
|
||||
" \"own-votes\" TEXT "
|
||||
+make-close+)))
|
||||
|
||||
(defun make-status ()
|
||||
(query-low-level (strcat (prepare-table +table-status+ :autogenerated-id-p nil)
|
||||
" \"status-id\" TEXT NOT NULL, "
|
||||
|
|
@ -452,7 +487,10 @@
|
|||
+table-subscribed-tag+
|
||||
+table-tag-histogram+
|
||||
+table-attachment+
|
||||
+table-conversation+))
|
||||
+table-conversation+
|
||||
+table-pagination-status+
|
||||
+table-poll-option+
|
||||
+table-poll+))
|
||||
|
||||
(defun build-views ())
|
||||
|
||||
|
|
@ -478,6 +516,8 @@
|
|||
(make-tag-histogram)
|
||||
(make-conversation)
|
||||
(make-pagination-status)
|
||||
(make-poll-option)
|
||||
(make-poll)
|
||||
(build-all-indices)
|
||||
(fs:set-file-permissions (db-path) (logior fs:+s-irusr+ fs:+s-iwusr+))))
|
||||
|
||||
|
|
@ -714,14 +754,98 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
|||
(and object
|
||||
(tooter:original object)))
|
||||
|
||||
(defun find-poll-option (poll-id title)
|
||||
(fetch-single (select :*
|
||||
(from +table-poll-option+)
|
||||
(where (:and (:= :title title)
|
||||
(:= :poll-id poll-id))))))
|
||||
|
||||
(defun poll-option-exists-p (poll-id title)
|
||||
(find-poll-option poll-id title))
|
||||
|
||||
(defun all-poll-options (poll-id)
|
||||
(fetch-all-rows (select :*
|
||||
(from +table-poll-option+)
|
||||
(where (:= :poll-id poll-id)))))
|
||||
|
||||
(defun find-poll (poll-id)
|
||||
(fetch-from-id +table-poll+ poll-id))
|
||||
|
||||
(defun find-poll-bound-to-status (status-id)
|
||||
(fetch-single (select :*
|
||||
(from +table-poll+)
|
||||
(where (:= :status-id status-id)))))
|
||||
|
||||
(defun poll-bound-to-status-exists-p (status-id)
|
||||
(find-poll-bound-to-status status-id))
|
||||
|
||||
(defmethod update-db ((object tooter:poll-option) &key (poll-id nil) &allow-other-keys)
|
||||
(assert poll-id)
|
||||
(with-accessors ((title tooter:title)
|
||||
(votes-count tooter:votes-count)) object
|
||||
(let ((insert-query (make-insert +table-poll-option+
|
||||
(:title :votes-count :poll-id)
|
||||
(title votes-count poll-id)))
|
||||
(update-query (make-update +table-poll-option+
|
||||
(:votes-count)
|
||||
(votes-count)
|
||||
(:and (:= :title title)
|
||||
(:= :poll-id poll-id)))))
|
||||
(if (poll-option-exists-p poll-id title)
|
||||
(query update-query)
|
||||
(query insert-query)))))
|
||||
|
||||
(defmethod update-db ((object tooter:poll) &key (status-id nil) &allow-other-keys)
|
||||
(assert status-id)
|
||||
(with-accessors ((id tooter:id)
|
||||
(expires-at tooter:expires-at)
|
||||
(expired tooter:expired)
|
||||
(multiple tooter:multiple)
|
||||
(voters-count tooter:voters-count)
|
||||
(votes-count tooter:votes-count)
|
||||
(voted tooter:voted)
|
||||
(own-votes tooter:own-votes)
|
||||
(options tooter:options)) object
|
||||
(let* ((expire-date (prepare-for-db expires-at))
|
||||
(actual-expired (prepare-for-db expired :to-integer t))
|
||||
(actual-multiple (prepare-for-db multiple :to-integer t))
|
||||
(actual-voted (prepare-for-db voted :to-integer t))
|
||||
(actual-own-votes (join-with-strings (if own-votes
|
||||
(mapcar #'to-s own-votes)
|
||||
"")
|
||||
+tag-separator+))
|
||||
(insert-query (make-insert +table-poll+
|
||||
(:id
|
||||
:status-id
|
||||
:expire-date
|
||||
:expired
|
||||
:multiple
|
||||
:voters-count
|
||||
:votes-count
|
||||
:voted
|
||||
:own-votes)
|
||||
(id
|
||||
status-id
|
||||
expire-date
|
||||
actual-expired
|
||||
actual-multiple
|
||||
voters-count
|
||||
votes-count
|
||||
actual-voted
|
||||
actual-own-votes))))
|
||||
(when (not (poll-bound-to-status-exists-p status-id))
|
||||
(query insert-query))
|
||||
(loop for option in options do
|
||||
(update-db option :poll-id id)))))
|
||||
|
||||
(defmethod update-db ((object tooter:attachment) &key (status-id nil) &allow-other-keys)
|
||||
(with-accessors ((id tooter:id)
|
||||
(kind tooter:kind)
|
||||
(url tooter:url)
|
||||
(kind tooter:kind)
|
||||
(url tooter:url)
|
||||
(preview-url tooter:preview-url)
|
||||
(remote-url tooter:remote-url)
|
||||
(text-url tooter:text-url)
|
||||
(metadata tooter:metadata)
|
||||
(remote-url tooter:remote-url)
|
||||
(text-url tooter:text-url)
|
||||
(metadata tooter:metadata)
|
||||
(description tooter:description)
|
||||
(blurhash tooter:blurhash)) object
|
||||
(assert status-id)
|
||||
|
|
@ -902,7 +1026,8 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
|||
(account tooter:account)
|
||||
(tags tooter:tags)
|
||||
(application tooter:application)
|
||||
(media-attachments tooter:media-attachments)) object
|
||||
(media-attachments tooter:media-attachments)
|
||||
(poll tooter:poll)) object
|
||||
(update-db account)
|
||||
(let* ((account-id (tooter:id account))
|
||||
(actual-created-at (decode-datetime-string created-at))
|
||||
|
|
@ -981,8 +1106,8 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
|||
folder))))
|
||||
(when (not (single-status-exists-p id timeline folder))
|
||||
(query insert-query)
|
||||
;; attachments and tag history latest because of the reference from this table
|
||||
;; to table status
|
||||
;; attachments, tag history latest because of the
|
||||
;; reference from this table to table status
|
||||
(map nil
|
||||
(lambda (media-attachment)
|
||||
(update-db media-attachment :status-id id))
|
||||
|
|
@ -997,7 +1122,10 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
|||
:skip-ignored-p skip-ignored-p
|
||||
:timeline +default-reblogged-timeline+)
|
||||
;; now try to decrypt message if possible/needed
|
||||
(maybe-decrypt-update-status-text id timeline folder)))))))
|
||||
(maybe-decrypt-update-status-text id timeline folder))
|
||||
;; add poll or update poll's votes
|
||||
(when poll
|
||||
(update-db poll :status-id id)))))))
|
||||
|
||||
(defun maybe-decrypt-update-status-text (status-id timeline folder)
|
||||
"Decrypt, if possible, status identified by `status-id', `timeline' and `folder'.
|
||||
|
|
@ -1329,6 +1457,15 @@ row."
|
|||
|
||||
(gen-access-message-row conversation-root-status-id :root-status-id)
|
||||
|
||||
(gen-access-message-row poll-expired-p :expired)
|
||||
|
||||
(gen-access-message-row expire-date :expire-date)
|
||||
|
||||
(gen-access-message-row title :title)
|
||||
|
||||
(defun row-votes-count (row)
|
||||
(and row (db-getf row :votes-count 0)))
|
||||
|
||||
(defun row-message-reply-to-id (row)
|
||||
(and row
|
||||
(db-getf row :in-reply-to-id)))
|
||||
|
|
|
|||
|
|
@ -230,3 +230,30 @@
|
|||
(right-padding boosted-label padding-length)
|
||||
boosted-username)))
|
||||
text))
|
||||
|
||||
(defun poll->text (poll-id width)
|
||||
(when poll-id
|
||||
(when-let* ((poll (db:find-poll poll-id))
|
||||
(options (db:all-poll-options poll-id))
|
||||
(all-titles (loop for option in options collect (db:row-title option)))
|
||||
(vote-sum (reduce #'+
|
||||
(mapcar #'db:row-votes-count options)))
|
||||
(max-title-w (find-max-line-length all-titles))
|
||||
(max-bar-width (- width max-title-w 6))
|
||||
(bar-char (swconf:vote-vertical-bar))
|
||||
(expiredp (db:row-poll-expired-p poll)))
|
||||
(with-output-to-string (stream)
|
||||
(loop for option in options do
|
||||
(let* ((title (left-padding (db:row-title option) max-title-w))
|
||||
(rate (handler-case
|
||||
(/ (db:row-votes-count option)
|
||||
vote-sum)
|
||||
(error () 0)))
|
||||
(vote (left-padding (format nil "~a%" (* 100 rate)) 4))
|
||||
(bar-w (truncate (* rate max-bar-width))))
|
||||
(format stream "~a " title)
|
||||
(loop for i from 0 below bar-w do
|
||||
(princ bar-char stream))
|
||||
(format stream " ~a~%" (left-padding vote (- max-bar-width bar-w)))))
|
||||
(when expiredp
|
||||
(format stream "~%~a~%" (_ "The poll has expired")))))))
|
||||
|
|
|
|||
|
|
@ -692,6 +692,10 @@
|
|||
:next-in-history
|
||||
:most-recent-history-id
|
||||
:purge-history
|
||||
:all-poll-options
|
||||
:find-poll
|
||||
:find-poll-option
|
||||
:find-poll-bound-to-status
|
||||
:update-db
|
||||
:message-root
|
||||
:message-children
|
||||
|
|
@ -722,6 +726,10 @@
|
|||
:row-conversation-folder
|
||||
:row-conversation-root-status-id
|
||||
:row-conversation-ignored-p
|
||||
:row-poll-expired-p
|
||||
:row-expire-date
|
||||
:row-title
|
||||
:row-votes-count
|
||||
:row-message-reply-to-id
|
||||
:next-status-tree
|
||||
:previous-status-tree
|
||||
|
|
@ -866,6 +874,7 @@
|
|||
:+key-window+
|
||||
:+key-focus+
|
||||
:+key-mark+
|
||||
:+key-vote-vertical-bar+
|
||||
:+key-info-dialog+
|
||||
:+key-help-dialog+
|
||||
:+key-error-dialog+
|
||||
|
|
@ -913,6 +922,7 @@
|
|||
:parse
|
||||
:load-config-file
|
||||
:external-editor
|
||||
:vote-vertical-bar
|
||||
:crypted-mark-value
|
||||
:quick-help-header-colors
|
||||
:window-titles-ends
|
||||
|
|
@ -1555,7 +1565,8 @@
|
|||
:attachment-type->metadata
|
||||
:status-attachments->text
|
||||
:message-original->text-body
|
||||
:message-original->text-header))
|
||||
:message-original->text-header
|
||||
:poll->text))
|
||||
|
||||
(defpackage :thread-window
|
||||
(:use
|
||||
|
|
|
|||
|
|
@ -321,6 +321,7 @@
|
|||
attribute
|
||||
new-message
|
||||
mark
|
||||
vote-vertical-bar
|
||||
crypted
|
||||
histogram
|
||||
error-dialog
|
||||
|
|
@ -415,6 +416,11 @@
|
|||
|
||||
;;;; interface
|
||||
|
||||
(defun vote-vertical-bar ()
|
||||
(or (access:accesses *software-configuration*
|
||||
+key-vote-vertical-bar+)
|
||||
"="))
|
||||
|
||||
(defun crypted-mark-value ()
|
||||
(or (access:accesses *software-configuration*
|
||||
+key-crypted+
|
||||
|
|
|
|||
|
|
@ -775,9 +775,13 @@ db:renumber-timeline-message-index."
|
|||
(original (db-utils:db-getf fields :content ""))
|
||||
(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)))
|
||||
(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)))))
|
||||
(multiple-value-bind (reblogged-status-body reblogged-status-attachments)
|
||||
(reblogged-data fields)
|
||||
(let ((actual-body (if (string= body reblogged-status-body)
|
||||
|
|
@ -789,6 +793,7 @@ db:renumber-timeline-message-index."
|
|||
(setf (message-window:source-text *message-window*)
|
||||
(strcat header
|
||||
actual-body
|
||||
poll-text
|
||||
actual-attachments))
|
||||
(db:mark-status-red-p timeline-type timeline-folder status-id)
|
||||
(resync-rows-db object :redraw t)
|
||||
|
|
|
|||
Loading…
Reference in New Issue