diff --git a/etc/default-theme.conf b/etc/default-theme.conf index 7b82ec5..c056549 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -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 diff --git a/etc/init.lisp b/etc/init.lisp index 9ab8aff..7f75491 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -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) diff --git a/src/api-client.lisp b/src/api-client.lisp index 80135da..213f1fc 100644 --- a/src/api-client.lisp +++ b/src/api-client.lisp @@ -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* diff --git a/src/package.lisp b/src/package.lisp index 718ff7e..3d9427f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/program-events.lisp b/src/program-events.lisp index aca7fbb..d38e831 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -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 () diff --git a/src/scheduled-events.lisp b/src/scheduled-events.lisp index 77a09d8..c158a69 100644 --- a/src/scheduled-events.lisp +++ b/src/scheduled-events.lisp @@ -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) diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index fb94d00..793b74e 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -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))) diff --git a/src/thread-window.lisp b/src/thread-window.lisp index c926786..a8d2284 100644 --- a/src/thread-window.lisp +++ b/src/thread-window.lisp @@ -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)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 0ddf4ab..2094bef 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -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)))