mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-11 07:30:34 +01:00
- 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;
This commit is contained in:
parent
77d8deb84e
commit
7307444c86
@ -45,6 +45,10 @@
|
|||||||
|
|
||||||
(load-module "expand-abbrev-command-window.lisp")
|
(load-module "expand-abbrev-command-window.lisp")
|
||||||
|
|
||||||
|
;; delete posts using a regeula expression
|
||||||
|
|
||||||
|
(load-module "delete-by-regex.lisp")
|
||||||
|
|
||||||
;; keybindings syntax:
|
;; keybindings syntax:
|
||||||
|
|
||||||
;; a command is executed after a sequence of one or more keys. a key
|
;; a command is executed after a sequence of one or more keys. a key
|
||||||
|
47
modules/delete-by-regex.lisp
Normal file
47
modules/delete-by-regex.lisp
Normal file
@ -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: ")))
|
@ -284,11 +284,13 @@ Returns nil if the user did not provided a server in the configuration file"
|
|||||||
(tooter:unreblog *client*
|
(tooter:unreblog *client*
|
||||||
status-id))
|
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))
|
(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
|
"Get messages (status) belonging to a timeline
|
||||||
|
|
||||||
- kind: one of
|
- kind: one of
|
||||||
db:+federated-timeline+
|
api-client:+public-timeline+
|
||||||
db:+home-timeline+
|
db:+home-timeline+
|
||||||
|
|
||||||
- local: get status local to the instance the client is connected to
|
- 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
|
- min-id starts getting messages newer than this id
|
||||||
- since-id cut the messages got starting from this id
|
- since-id cut the messages got starting from this id
|
||||||
- limit gets a maimum of messages up to this value."
|
- 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+)))
|
(string-equal kind db:+home-timeline+)))
|
||||||
(tooter:timeline *client*
|
(tooter:timeline *client*
|
||||||
kind
|
kind
|
||||||
|
@ -814,9 +814,9 @@ db:renumber-timeline-message-index."
|
|||||||
(suggested-message-index nil)
|
(suggested-message-index nil)
|
||||||
(suggested-status-id nil))
|
(suggested-status-id nil))
|
||||||
(with-accessors ((row-selected-index row-selected-index)
|
(with-accessors ((row-selected-index row-selected-index)
|
||||||
(rows rows)
|
(rows rows)
|
||||||
(timeline-folder timeline-folder)
|
(timeline-folder timeline-folder)
|
||||||
(timeline-type timeline-type)) object
|
(timeline-type timeline-type)) object
|
||||||
(when-window-shown (object)
|
(when-window-shown (object)
|
||||||
(cond
|
(cond
|
||||||
(suggested-status-id
|
(suggested-status-id
|
||||||
@ -827,8 +827,8 @@ db:renumber-timeline-message-index."
|
|||||||
(suggested-message-index
|
(suggested-message-index
|
||||||
(update-thread-window object suggested-message-index))
|
(update-thread-window object suggested-message-index))
|
||||||
(t
|
(t
|
||||||
(let* ((selected-row (selected-row object))
|
(when-let* ((selected-row (selected-row object))
|
||||||
(message-index (db:row-message-index (fields selected-row))))
|
(message-index (db:row-message-index (fields selected-row))))
|
||||||
(update-thread-window object message-index))))
|
(update-thread-window object message-index))))
|
||||||
(when redraw
|
(when redraw
|
||||||
(draw object))))
|
(draw object))))
|
||||||
|
Loading…
x
Reference in New Issue
Block a user