diff --git a/etc/init.lisp b/etc/init.lisp index 944c614..298f635 100644 --- a/etc/init.lisp +++ b/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 diff --git a/modules/delete-by-regex.lisp b/modules/delete-by-regex.lisp new file mode 100644 index 0000000..3dce62e --- /dev/null +++ b/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 . + +(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: "))) diff --git a/src/api-client.lisp b/src/api-client.lisp index 87e548c..3d4e88d 100644 --- a/src/api-client.lisp +++ b/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 diff --git a/src/thread-window.lisp b/src/thread-window.lisp index b77a661..4266ce8 100644 --- a/src/thread-window.lisp +++ b/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))))