cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-02 04:36:43 +01:00
Code Issues

- added support for announcements.

Browse Source
This commit is contained in:
cage 2023-09-25 19:03:32 +02:00
parent f48e456f78
commit 6a37cae537
9 changed files with 116 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
etc/default-theme.conf
View File

@ -19,6 +19,10 @@
# - underline
# - blink
announcements.icon = "📣"
announcements.separator = "∴ ∴ ∴"
left-arrow = "←"
# The text that starts the title section of a window
@ -155,12 +159,13 @@ thread-window.modeline.foreground = yellow
# shown as a prefix for mentions in the modeline
thread-window.modeline.notification-icon.value = "📣"
thread-window.modeline.notification-icon.value = "🔔"
# this variable customize the information that the modeline will
# shows, values prefixed with a '%' will be expanded, allowe values to
# be expanded are:
# - %A announcements notification
# - %m mentions count
# - %u user account
# - %s server connected to
@ -171,7 +176,7 @@ thread-window.modeline.notification-icon.value = "📣"
# - %tags in selected messages (if any)
# - %% a percent sign
thread-window.modeline.value = "%m %u@%s ◈ %k %r/%t ◈ folder: %f ◈ tags: %h"
thread-window.modeline.value = "%A %m %u@%s ◈ %k %r/%t ◈ folder: %f ◈ tags: %h"
# this is the only width you have to specify as the others windows
# just fills the void left by this one

2
etc/init.lisp
View File

@ -159,6 +159,8 @@
(define-key "C-a" #'show-about-window)
(define-key "A" #'show-announcements)
(define-key "C-h A" #'apropos-help-global)
(define-key "C-h a" #'apropos-help)

16
src/api-client.lisp
View File

@ -268,13 +268,23 @@ Returns nil if the user did not provided a server in the configuration file"
,@remaining-forms))))
(defun-api-call get-announcements ()
"Get all the non dismissed announcements"
(tooter:get-announcements *client* :with-dismissed nil))
"Get all the non dismissed announcements"
(let ((all-announcements (tooter:get-announcements *client* :with-dismissed nil)))
;; even if asked for non dismissed posts, the server returns all the
;; announcements anyway...
(remove-if #'tooter:readp all-announcements)))
(defun-api-call dismiss-announcement (announcement-id)
"Dismisse an announcement identified by `announcement-id'"
"Dismiss an announcement identified by `announcement-id'"
(tooter:dismiss-announcement *client* announcement-id))
(defun dismiss-all-announcements (&optional announcements)
(loop for announcement in (or announcements
(get-announcements))
do
(dismiss-announcement (tooter:id announcement)))
announcements)
(defun-api-call favourite-status (status-id)
"Favourite a status identified by `status-id'"
(tooter:favourite *client*

10
src/package.lisp
View File

@ -1435,6 +1435,8 @@
:config-gopher-line-prefix-attribute
:config-gopher-line-prefix-foreground
:config-default-post-language
:config-announcements-separator
:config-announcements-icon
:link-regex->program-to-use
:link-regex->program-to-use-buffer-size
:use-tinmop-as-external-program-p
@ -1745,6 +1747,8 @@
:redraw-window-event
:send-to-pipe-event
:print-mentions-event
:show-announcements-event
:check-announcements-event
:delete-all-notifications-event
:dispatch-program-events
:dispatch-program-events-or-wait))
@ -1804,6 +1808,7 @@
:defun-api-call
:get-announcements
:dismiss-announcement
:dismiss-all-announcements
:favourite-status
:unfavourite-status
:reblog-status
@ -2372,6 +2377,8 @@
:timeline-type
:timeline-folder
:mentions-count
:add-announcements-notification
:remove-announcements-notification
:grow-tree-to-fit-window
:fit-timeline-to-window
:go-message-down
@ -3154,7 +3161,8 @@
:file-explorer-download-mirror
:clear-cache
:print-mentions
:delete-notifications))
:delete-notifications
:show-announcements))
(defpackage :scheduled-events
(:use

28
src/program-events.lisp
View File

@ -1872,6 +1872,34 @@
(windows:win-clear message-window)
(windows:draw message-window)))))))
(defclass show-announcements-event (program-event) ())
(defmethod process-event ((object show-announcements-event))
"Shows a window with all announcements"
(when-let* ((all-announcements (api-client:get-announcements))
(all-texts (mapcar #'html-utils:html->text
(mapcar #'tooter:content all-announcements)))
(lines (reduce #'append
(mapcar #'text-utils:split-lines all-texts)))
(window-content (text-utils:join-with-strings* (swconf:config-announcements-separator)
lines)))
(api-client:dismiss-all-announcements all-announcements)
(line-oriented-window:make-blocking-list-dialog-window specials:*main-window*
window-content
window-content
nil
(_ "Announcements "))
(push-event (make-instance 'check-announcements-event))))
(defclass check-announcements-event (program-event) ())
(defmethod process-event ((object check-announcements-event))
"Shows a window with all announcements"
(if (api-client:get-announcements)
(thread-window:add-announcements-notification specials:*thread-window*)
(thread-window:remove-announcements-notification specials:*thread-window*))
(windows:draw specials:*thread-window*))
;;;; end events
(defun dispatch-program-events ()

13
src/scheduled-events.lisp
View File

@ -23,7 +23,9 @@
(define-constant +refresh-gemlog-subscriptions-frequency+ 50000 :test #'=)
(define-constant +purge-gemlog-entries+ 30000 :test #'=)
(define-constant +purge-gemlog-entries-frequency+ 30000 :test #'=)
(define-constant +announcements-check-frequency+ 10000 :test #'=)
(defun triggedp (ticks frequency)
(= (rem ticks frequency)
@ -50,7 +52,7 @@
+refresh-gemlog-subscriptions-frequency+)
(ui:gemlog-refresh-all))
(gen-scheduler-function (purge-gemlog-entries +purge-gemlog-entries+)
(gen-scheduler-function (purge-gemlog-entries +purge-gemlog-entries-frequency+)
(ui:notify (_ "Removing old gemlog posts…"))
(db:purge-seen-gemlog-entries)
(ui:notify (_ "Removed")))
@ -63,6 +65,11 @@
:chat (message-window:metadata *message-window*))))
(program-events:push-event show-event))))
(gen-scheduler-function (look-for-announcements
+announcements-check-frequency+)
(when *thread-window*
(program-events:push-event (make-instance 'program-events:check-announcements-event))))
(gen-at-boot-function purge-history
(db:purge-history))
@ -77,6 +84,8 @@
(when (api-pleroma:instance-pleroma-p)
(refresh-all-chats-messages ticks)
(refresh-all-chats-data ticks))
(when (not (api-pleroma:instance-pleroma-p))
(look-for-announcements ticks))
(refresh-gemlog-subscriptions ticks)
(purge-gemlog-entries ticks)
(purge-history)

17
src/software-configuration.lisp
View File

@ -552,6 +552,7 @@
notify-window
gempub-library-window
notification-icon
icon
life
quick-help
more-choices
@ -589,6 +590,8 @@
command-window
file-explorer
command-separator
separator
announcements
gemini
gemlog
gempub
@ -1596,12 +1599,19 @@
+key-input+
+key-foreground+))))
(gen-simple-access (default-post-language
:transform-value-fn identity)
(gen-simple-access (default-post-language)
+key-default+
+key-post+
+key-language+)
(gen-simple-access (announcements-separator)
+key-announcements+
+key-separator+)
(gen-simple-access (announcements-icon)
+key-announcements+
+key-icon+)
;;;;;; tests
(defun trivial-configuration-missing-value-check ()
@ -1630,6 +1640,7 @@
#'message-window-line-mark-values
#'message-window-attachments-header
#'config-post-allowed-language
#'config-default-post-language)
#'config-default-post-language
#'config-announcements-separator)
do
(funcall fn)))

29
src/thread-window.lisp
View File

@ -116,7 +116,12 @@
(mentions
:initform ()
:initarg :mentions
:accessor mentions)))
:accessor mentions)
(announcements
:initform nil
:initarg :announcements
:accessor announcements)))
(defmacro lambda-ignore-args (args &body body)
`(lambda (,@args)
@ -193,6 +198,15 @@
(length mentions)))
"")))
(defun expand-announcements (window)
(with-accessors ((announcements announcements)) window
(if announcements
(with-tuify-results (window)
(format nil
"~a"
(swconf:config-announcements-icon)))
"")))
(defun default-expander ()
(list (cons "%" (lambda (w) (with-tuify-results (w) "%")))
(cons "s" (lambda (w) (with-tuify-results (w) (swconf:config-server-name))))
@ -202,7 +216,8 @@
(cons "h" #'expand-message-hashtags)
(cons "t" #'expand-total-messages)
(cons "r" #'expand-redp-messages)
(cons "m" #'expand-mentions)))
(cons "m" #'expand-mentions)
(cons "A" #'expand-announcements)))
(defmethod initialize-instance :after ((object thread-window) &key &allow-other-keys)
(with-accessors ((mapping-code->fn mapping-code->fn)) object
@ -324,6 +339,10 @@
(defgeneric remove-mention (object status-id))
(defgeneric add-announcements-notification (object))
(defgeneric remove-announcements-notification (object))
(defun message-root (tree)
(mtree:root-node tree))
@ -1021,6 +1040,12 @@ db:renumber-timeline-message-index."
mentions))
object))
(defmethod add-announcements-notification ((object thread-window))
(setf (announcements object) t))
(defmethod remove-announcements-notification ((object thread-window))
(setf (announcements object) nil))
(defgeneric marked-to-delete-p (object))
(defmethod marked-to-delete-p ((object line))

5
src/ui-goodies.lisp
View File

@ -3478,3 +3478,8 @@ gemini client certificates!)."
"Delete all the notification from server"
(info-message (_ "Getting all notification, please wait…"))
(push-event (make-instance 'delete-all-notifications-event)))
(defun show-announcements ()
"Show an informative window about instance's announcements"
(info-message (_ "Getting all announcements, please wait…"))
(push-event (make-instance 'show-announcements-event)))