From 70b9918704242b2c5639a325a3bd367dc76b596a Mon Sep 17 00:00:00 2001 From: cage <cage-invalid@invalid> Date: Sun, 7 Jun 2020 11:50:36 +0200 Subject: [PATCH] - moved pleroma specific API to i package :api-pleroma; - 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. --- src/api-client.lisp | 2 +- src/api-pleroma.lisp | 27 +++++++++++++++++ src/db.lisp | 4 ++- src/message-rendering-utils.lisp | 50 +++++++++++++++++++++----------- src/package.lisp | 14 +++++++-- src/text-utils.lisp | 2 +- tinmop.asd | 1 + 7 files changed, 78 insertions(+), 22 deletions(-) create mode 100644 src/api-pleroma.lisp diff --git a/src/api-client.lisp b/src/api-client.lisp index 88c81fd..288f2bd 100644 --- a/src/api-client.lisp +++ b/src/api-client.lisp @@ -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" diff --git a/src/api-pleroma.lisp b/src/api-pleroma.lisp new file mode 100644 index 0000000..acec3d4 --- /dev/null +++ b/src/api-pleroma.lisp @@ -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))) diff --git a/src/db.lisp b/src/db.lisp index 6f61363..f3cdd76 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -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))) diff --git a/src/message-rendering-utils.lisp b/src/message-rendering-utils.lisp index 0d3a96e..8804cfb 100644 --- a/src/message-rendering-utils.lisp +++ b/src/message-rendering-utils.lisp @@ -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")))))))) diff --git a/src/package.lisp b/src/package.lisp index 47114f3..c4b067c 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/text-utils.lisp b/src/text-utils.lisp index 7d14701..56c3e65 100644 --- a/src/text-utils.lisp +++ b/src/text-utils.lisp @@ -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)) diff --git a/tinmop.asd b/tinmop.asd index 04487aa..0ade818 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -78,6 +78,7 @@ (:file "specials") (:file "complete") (:file "program-events") + (:file "api-pleroma") (:file "api-client") (:file "hooks") (:file "keybindings")