- updated NEWS;

- added module 'fetch-expired-poll';
- fixed updating poll database rows (previously was never updated);
- improved a bit appearance of polls;
- updated docstring;
- fixed indentation.

NEWS.org

@@ -1,17 +1,22 @@
 * 2024-xx-xx version 0.9.9.1414213562
-  - new features
-    - [fediverse] Multi account supported. Users can specify the account to use on the command line or switching at runtime.
+  - New features
+    - [fediverse] Multiple accounts supported. Users can specify the account to use on the command line or switching at runtime.
     - [TUI] added new commands:
-      - thread-go-to-parent-post
-      - thread-delete-subtree
-    - added a bash completion script
-    - prevented the poll's results to be printed before expiration
-    - [script] added the option to submit the feed to and antenna instance, when generating a gemlog;
+      * thread-go-to-parent-post;
+      * thread-delete-subtree.
+    - added a bash completion script;
+    - prevented the poll's results to be printed before expiration;
+    - [script] added the option to submit the feed to an antenna instance, when generating a gemlog.
+    - [module] added 'fetch-expired-poll' that will fetch and display an expired poll for which the user submitted at least a vote.
   - Bugfix
-    - [TUI] fixed checks of configuration file
+    - [fediverse] fixed updating of polls (was not actually never updated before this version);
+    - [TUI] fixed checks of configuration file;
     - updated README to mention that also libjpegturbo and TK must be installed;
-    - [GUI] fixed managing of gemini responses when a titan request was performed (TOFU errors, TLS certificate password etc.)
-    - [TUI] fixed line wrapping of announcements window.
+    - [GUI] fixed managing of gemini responses when a titan request was performed (TOFU errors, TLS certificate password etc.);
+    - [TUI] fixed line wrapping of announcements window;
+    - [TUI] prevented crash when looking for links contained ina a empty message.
+
+  Thanks to people who run [[https://mastodon.uno/][mastodon.uno]] (and, needless to say, [[https://emacs.ch][emacs.ch]]) for their hosting, support and help to test this new release.
 
 * 2024-03-02 version 0.9.9.141421356
   - new features

data/modules/fetch-expired-poll.lisp

@@ -0,0 +1,41 @@
+;; tinmop module for rewrite link URLs before opening
+;; Copyright © 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 :modules)
+
+(defun fetch-expired-poll-from-notification (notification)
+  (notify "Checking for expired polls.")
+  (when (eq (tooter:kind notification)
+            :poll)
+    (let* ((timeline (thread-window:timeline-type *thread-window*))
+           (folder        (thread-window:timeline-folder *thread-window*))
+           (status        (tooter:status notification))
+           (status-id     (tooter:id status))
+           (refresh-event (make-instance 'refresh-thread-windows-event
+                                         :priority +minimum-event-priority+
+                                         :message-status-id status-id)))
+      (notify "Fetching expired poll")
+      (program-events:with-enqueued-process ()
+        (db:update-db (api-client:get-remote-status status-id)
+                      :folder folder
+                      :timeline timeline
+                      :skip-ignored-p nil)
+        (db:renumber-timeline-message-index timeline folder :account-id nil))
+      (push-event refresh-event)
+      (notify "Poll fetched"))))
+
+(hooks:add-hook 'hooks:*after-getting-fediverse-notification*
+                #'fetch-expired-poll-from-notification)

doc/tinmop.man

@@ -81,7 +81,7 @@ Start as gemini gui server only
 \fB-v, --version                   \fP
 Print program version and exit
 .TP
-\fB--fediverse-account             \fP
+\fB-F, --fediverse-account         \fP
 Specify a fediverse user account (format: user-name@server-name)
 
 .SH "Usage"
@@ -570,16 +570,19 @@ change-visibility
 
 .SS "Thread window"
 .TP
-\fB^        \fP
+\fB[        \fP
 thread-go-to-parent-post
 .TP
+\fB^        \fP
+thread-open-parent-post
+.TP
 \fB/ b      \fP
 thread-search-next-message-body
 .TP
 \fB/ m      \fP
 thread-search-next-message-meta
 .TP
-\fBC-J (key \fIenter\fP)      \fP
+\fBC-J (key \fIenter\fP)\fP
 thread-open-selected-message
 .TP
 \fBC-X m b  \fP

doc/tinmop.org

@@ -346,10 +346,11 @@
 
 ** Thread window
 
-- ^         :: thread-go-to-parent-post
+- [         :: thread-go-to-parent-post
+- ^         :: thread-open-parent-post
 - / b       :: thread-search-next-message-body
 - / m       :: thread-search-next-message-meta
-- C-J (key /enter/)       :: thread-open-selected-message
+- C-J (key /enter/) :: thread-open-selected-message
 - C-X m b   :: boost-selected-status
 - C-X m f   :: favourite-selected-status
 - C-X m r b :: unboost-selected-status

etc/init.lisp

@@ -49,6 +49,10 @@
 
 (load-module "delete-by-regex.lisp")
 
+;; fetch expired polls when deleting notifications
+
+(load-module "fetch-expired-poll.lisp")
+
 ;; keybindings syntax:
 
 ;; a command is executed after a sequence  of one or more keys.  a key
@@ -270,7 +274,9 @@
                 (status-id    (db:row-message-status-id selected-row)))
     (ui:info-message (format nil "ID: ~a" status-id))))
 
-(define-key "^"         #'thread-go-to-parent-post                    *thread-keymap*)
+(define-key "["         #'thread-go-to-parent-post                    *thread-keymap*)
+
+(define-key "^"         #'thread-open-parent-post                     *thread-keymap*)
 
 (define-key "/ b"       #'thread-search-next-message-body             *thread-keymap*)
 

src/api-client.lisp

@@ -820,12 +820,18 @@ the latest 15 mentions)."
   "Get all notifications"
   (let ((notifications-so-far (sort-id< (notifications nil excluded-types))))
     (when notifications-so-far
+      (loop for notification in notifications-so-far do
+        (hooks:run-hook 'hooks:*after-getting-fediverse-notification*
+                        notification))
       (labels ((%notifications ()
                  (when-let* ((min-id        (tooter:id (first notifications-so-far)))
                              (notifications (sort-id< (notifications min-id excluded-types))))
 
                    (loop for notification in notifications do
-                        (pushnew notification notifications-so-far :test (make-id=)))
+                     (when (find notification notifications-so-far :test (make-id=))
+                       (hooks:run-hook 'hooks:*after-getting-fediverse-notification*
+                                       notification)
+                       (push notification notifications-so-far)))
                    (setf notifications-so-far (sort-id< notifications-so-far))
                    (when notifications
                      (%notifications)))))

src/db.lisp

@@ -1070,11 +1070,32 @@ than (swconf:config-purge-history-days-offset) days in the past"
                                        voters-count
                                        votes-count
                                        actual-voted
-                                       actual-own-votes))))
-      (when (not (poll-bound-to-status-exists-p status-id))
-        (query insert-query))
+                                       actual-own-votes)))
+           (update-query (make-update +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)
+                                      (:= :id id))))
+      (if (poll-bound-to-status-exists-p status-id)
+          (query update-query)
+          (query insert-query))
       (loop for option in options do
-           (update-db option :poll-id id)))))
+        (update-db option :poll-id id)))))
 
 (defmethod update-db ((object tooter:attachment) &key (attached-to-id nil) &allow-other-keys)
   (with-accessors ((id  tooter:id)

src/hooks.lisp

@@ -139,3 +139,6 @@ open the links")
 
 (defparameter *after-titan-request-sent* '()
   "Run these hooks after a titan request has been sent")
+
+(defparameter *after-getting-fediverse-notification* '()
+  "Run these hooks for each notification got")

src/message-rendering-utils.lisp

@@ -334,7 +334,7 @@
                                         (/ (db:row-votes-count option)
                                            vote-sum)
                                       (error () 0)))
-                      (vote         (left-padding (format nil "~f%" (* 100 rate)) 4))
+                      (vote         (left-padding (format nil "~,2f%" (* 100 rate)) 4))
                       (bar-w        (truncate (* rate max-bar-width))))
                  (format stream
                          "~a~a~a "

src/package.lisp

@@ -1922,7 +1922,8 @@
    :*after-gemini-socket*
    :*after-gemini-request-sent*
    :*after-titan-socket*
-   :*after-titan-request-sent*))
+   :*after-titan-request-sent*
+   :*after-getting-fediverse-notification*))
 
 (defpackage :keybindings
   (:use
@@ -3204,7 +3205,8 @@
    :show-announcements
    :show-parent-post
    :switch-fediverse-account
-   :thread-go-to-parent-post))
+   :thread-go-to-parent-post
+   :thread-open-parent-post))
 
 (defpackage :scheduled-events
   (:use

src/thread-window.lisp

@@ -842,8 +842,8 @@ db:renumber-timeline-message-index."
       (cond
         (suggested-status-id
          (a:when-let* ((message-index (message-tuple-id->message-index timeline-type
-                                                               timeline-folder
-                                                               suggested-status-id)))
+                                                                       timeline-folder
+                                                                       suggested-status-id)))
            (update-thread-window object message-index)))
         (suggested-message-index
          (update-thread-window object suggested-message-index))

src/ui-goodies.lisp

@@ -3571,7 +3571,7 @@ gemini client certificates!)."
   (push-event (make-instance 'print-mentions-event)))
 
 (defun delete-notifications ()
-  "Delete all the notification from server"
+  "Delete all the notification from server (also print the fetched notifications)."
   (info-message (_ "Getting all notification, please wait…"))
   (push-event (make-instance 'delete-all-notifications-event)))
 
@@ -3655,6 +3655,11 @@ gemini client certificates!)."
               (status-parent-row  (db::find-status-id-folder-timeline generic-parent-id folder timeline))
               ;; ...and get the correct message index
               (index              (db:row-message-index status-parent-row))
-              (event              (make-instance 'thread-goto-message
+              (goto-event         (make-instance 'thread-goto-message
                                                  :payload index)))
-    (push-event event)))
+    (push-event goto-event)))
+
+(defun thread-open-parent-post ()
+  "Move to, select and open parent post"
+  (thread-go-to-parent-post)
+  (thread-open-selected-message))