- added new module: 'delete-by-regex.lisp';

- fixed bug that prevented to update local and federated timeline;
- prevented crash when syncing thread window that contains no posts;

etc/init.lisp

@@ -45,6 +45,10 @@
 
 (load-module "expand-abbrev-command-window.lisp")
 
+;; delete posts using a regeula expression
+
+(load-module "delete-by-regex.lisp")
+
 ;; keybindings syntax:
 
 ;; a command is executed after a sequence  of one or more keys.  a key

modules/delete-by-regex.lisp

@@ -0,0 +1,47 @@
+;; tinmop module to delete multiple posts matching a regular expression
+;; Copyright © 2021 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 mark-message-deleted-by-regex (regex)
+  (when-let ((scanner (ignore-errors (create-scanner regex))))
+    (with-accessors ((row-selected-index row-selected-index)
+                     (rows               rows)
+                     (timeline-type      thread-window:timeline-type)
+                     (timeline-folder    thread-window:timeline-folder)) *thread-window*
+      (let ((event-payload
+              (lambda ()
+                (line-oriented-window:map-rows specials:*thread-window*
+                                               (lambda (a)
+                                                 (let* ((fields    (line-oriented-window:fields a))
+                                                        (user      (db:row-message-username  fields))
+                                                        (subject   (db:row-message-subject   fields))
+                                                        (status-id (db:row-message-status-id fields)))
+                                                   (when (or (scan scanner user)
+                                                             (scan scanner subject))
+                                                     (db:mark-status-deleted-p timeline-type
+                                                                               timeline-folder
+                                                                               status-id)))))
+                (line-oriented-window:resync-rows-db *thread-window* :redraw t))))
+        (push-event (make-instance 'function-event
+                                   :payload event-payload))))))
+
+(defun delete-post-using-regex ()
+  "Delete all posts matching (in field username or subject) a regual expression."
+  (flet ((on-input-complete (regex)
+           (mark-message-deleted-by-regex regex)))
+    (ask-string-input #'on-input-complete
+                      :prompt "Regex: ")))

src/api-client.lisp

@@ -284,11 +284,13 @@ Returns nil if the user did not provided a server in the configuration file"
   (tooter:unreblog *client*
                    status-id))
 
+(define-constant +public-timeline+ "public" :test #'string=)
+
 (defun-api-call get-timeline (kind &key local only-media max-id since-id min-id (limit 20))
   "Get messages (status) belonging to a timeline
 
 - kind: one of
-     db:+federated-timeline+
+     api-client:+public-timeline+
      db:+home-timeline+
 
 - local: get status local to the instance the client is connected to
@@ -298,7 +300,7 @@ Returns nil if the user did not provided a server in the configuration file"
 - min-id starts getting messages newer than this id
 - since-id cut the messages got starting from this id
 - limit gets a maimum of messages up to this value."
-  (assert (or (string-equal kind db:+federated-timeline+)
+  (assert (or (string-equal kind +public-timeline+)
               (string-equal kind db:+home-timeline+)))
   (tooter:timeline *client*
                    kind

src/thread-window.lisp

@@ -814,9 +814,9 @@ db:renumber-timeline-message-index."
                              (suggested-message-index nil)
                              (suggested-status-id     nil))
   (with-accessors ((row-selected-index row-selected-index)
-                   (rows             rows)
-                   (timeline-folder timeline-folder)
-                   (timeline-type   timeline-type)) object
+                   (rows               rows)
+                   (timeline-folder    timeline-folder)
+                   (timeline-type      timeline-type)) object
     (when-window-shown (object)
       (cond
         (suggested-status-id
@@ -827,8 +827,8 @@ db:renumber-timeline-message-index."
         (suggested-message-index
          (update-thread-window object suggested-message-index))
         (t
-         (let* ((selected-row  (selected-row object))
-                (message-index (db:row-message-index (fields selected-row))))
+         (when-let* ((selected-row  (selected-row object))
+                     (message-index (db:row-message-index (fields selected-row))))
            (update-thread-window object message-index))))
       (when redraw
         (draw object))))