cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-31 04:24:48 +01:00
Code Issues

- moved pleroma specific API to i package :api-pleroma;

Browse Source 
- renamed function: 'text-utils:left-padding-suffix' to 'text-utils:left-padding-prefix';
- rendered the choice index for poll's choicehs;
- shown if a poll allows multiple choiches.
This commit is contained in:
cage 2020-06-07 11:50:36 +02:00
parent 9802d6f034
commit 70b9918704
7 changed files with 78 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/api-client.lisp
View File

@ -642,7 +642,7 @@ the latest 15 mentions)."
(defun-w-lock delete-notification (notification-id)
*client-lock*
"Delete a notification identified by `notification-id'"
(tooter:delete-notification-deprecated *client* notification-id))
(api-pleroma:delete-notification *client* notification-id))
(defun sort-id< (list)
"Sort entities by id in descending order"

27
src/api-pleroma.lisp Normal file
View File

@ -0,0 +1,27 @@
;; tinmop: an humble mastodon client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :api-pleroma)
(defgeneric delete-notification (object id))
(defmethod delete-notification ((object tooter:client) (id string))
(tooter:submit object
"/api/v1/notifications/dismiss"
:id id))
(defmethod delete-notification ((object tooter:client) (notification tooter:notification))
(delete-notification object (tooter:id notification)))

4
src/db.lisp
View File

@ -1459,10 +1459,12 @@ row."
(gen-access-message-row poll-expired-p :expired)
(gen-access-message-row expire-date :expire-date)
(gen-access-message-row poll-multiple-vote-p :multiple)
(gen-access-message-row title :title)
(gen-access-message-row expire-date :expire-date)
(defun row-votes-count (row)
(and row (db-getf row :votes-count 0)))

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

@ -233,28 +233,44 @@
(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 #'+
(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)))
(all-rendered-indices (loop for idx from 0 below (length all-titles) collect
(format nil "[~a] " idx)))
(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)))
(let ((expiredp (db:row-poll-expired-p poll)))
(max-title-w (find-max-line-length all-titles))
(max-index-w (find-max-line-length all-rendered-indices))
(max-bar-width (- width
max-title-w
max-index-w
6))
(bar-char (swconf:vote-vertical-bar)))
(let ((expiredp (db:row-poll-expired-p poll))
(multiple-vote-allowed (db:row-poll-multiple-vote-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 title in all-titles
for index in all-rendered-indices
for option in options
do
(let* ((padded-title (left-padding title max-title-w))
(padded-index (left-padding index max-index-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~a " padded-index padded-title)
(loop for i from 0 below bar-w do
(princ bar-char stream))
(format stream " ~a~%" (left-padding vote (+ 4 ; size of vote percent: ' nnn%'
(- max-bar-width bar-w))))))
(if multiple-vote-allowed
(format stream "~%~a~%" (_ "Multiple choices allowed"))
(format stream "~%~a~%" (_ "A single choice allowed")))
(when expiredp
(format stream "~%~a~%" (_ "The poll has expired"))))))))

14
src/package.lisp
View File

@ -340,7 +340,7 @@
:right-padding
:right-padding-suffix
:left-padding
:left-padding-suffix
:left-padding-prefix
:ellipsize
:justify-monospaced-text
:flush-left-mono-text
@ -727,8 +727,9 @@
:row-conversation-root-status-id
:row-conversation-ignored-p
:row-poll-expired-p
:row-expire-date
:row-poll-multiple-vote-p
:row-title
:row-expire-date
:row-votes-count
:row-message-reply-to-id
:next-status-tree
@ -1168,6 +1169,15 @@
:status-id
:timeline))
(defpackage :api-pleroma
(:use
:cl
:alexandria
:config
:constants)
(:export
:delete-notification))
(defpackage :api-client
(:use
:cl

2
src/text-utils.lisp
View File

@ -185,7 +185,7 @@
:initial-element padding-char)
str))
(defun left-padding-suffix (str total-size &key (padding-char #\Space))
(defun left-padding-prefix (str total-size &key (padding-char #\Space))
(make-string (max 0 (- total-size (length str)))
:initial-element padding-char))

1
tinmop.asd
View File

@ -78,6 +78,7 @@
(:file "specials")
(:file "complete")
(:file "program-events")
(:file "api-pleroma")
(:file "api-client")
(:file "hooks")
(:file "keybindings")