152 lines
5.5 KiB
EmacsLisp
152 lines
5.5 KiB
EmacsLisp
;;; elfeed-prune.el --- Elfeed database pruning -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2024 Bram Schoenmakers
|
|
|
|
;; Author: Bram Schoenmakers <me@bramschoenmakers.nl>
|
|
;; Maintainer: Bram Schoenmakers <me@bramschoenmakers.nl>
|
|
;; Created: 1 July 2024
|
|
;; Package-Version: 0.1
|
|
;; Package-Requires: ((emacs "29.1"))
|
|
;; Keywords:
|
|
;; URL:
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;; MIT License
|
|
|
|
;; Copyright (c) 2024 Bram Schoenmakers
|
|
|
|
;; Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
;; of this software and associated documentation files (the "Software"), to deal
|
|
;; in the Software without restriction, including without limitation the rights
|
|
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
|
;; copies of the Software, and to permit persons to whom the Software is
|
|
;; furnished to do so, subject to the following conditions:
|
|
|
|
;; The above copyright notice and this permission notice shall be included in all
|
|
;; copies or substantial portions of the Software.
|
|
|
|
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
|
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
;; SOFTWARE.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; Code:
|
|
|
|
(require 'elfeed)
|
|
|
|
(defcustom elfeed-prune-enabled nil
|
|
"Set to t to perform actual pruning on the database.
|
|
|
|
This boolean serves as a safety pin, because the elfeed database
|
|
was not designed to have items removed. By setting this boolean
|
|
to t you are aware of the risks."
|
|
:group 'elfeed-prune
|
|
:type 'boolean)
|
|
|
|
(defcustom elfeed-prune-days-read 90
|
|
"Read items older than this amount of days will be pruned."
|
|
:group 'elfeed-prune
|
|
:type 'natnum)
|
|
|
|
(defcustom elfeed-prune-days-unread 30
|
|
"Unread items older than this amount of days will be pruned."
|
|
:group 'elfeed-prune
|
|
:type 'natnum)
|
|
|
|
(defcustom elfeed-prune-gc t
|
|
"Run `elfeed-db-gc' to remove stale content from disk."
|
|
:group 'elfeed-prune
|
|
:type 'boolean)
|
|
|
|
(defcustom elfeed-prune-predicates
|
|
(list #'elfeed-prune--entry-too-old-p)
|
|
"Entries that match *any* of these predicates are pruned.
|
|
|
|
Each predicate accepts an entry and a feed object and should
|
|
return t when the entry should be pruned, unless any of the
|
|
predicates in `elfeed-prune-keep-predicates' returns t."
|
|
:group 'elfeed-prune
|
|
:type 'list)
|
|
|
|
(defcustom elfeed-prune-keep-predicates nil
|
|
"Always keep entries that match one of these predicates.
|
|
|
|
Each predicate accepts an entry and a feed object and should
|
|
return t when the entry should be kept."
|
|
:group 'elfeed-prune
|
|
:type 'list)
|
|
|
|
(defun elfeed-prune--entry-too-old-p (entry _)
|
|
"Return t if the given ENTRY is considered too old.
|
|
|
|
The thresholds are configured through the variables
|
|
`elfeed-prune-days-read' and `elfeed-prune-days-unread'."
|
|
(let* ((current-time (float-time))
|
|
(entry-time (elfeed-entry-date entry))
|
|
(unread-p (seq-contains-p (elfeed-entry-tags entry) 'unread))
|
|
(threshold-days (if unread-p
|
|
elfeed-prune-days-unread
|
|
elfeed-prune-days-read))
|
|
(threshold-seconds (* 60 60 24 threshold-days))
|
|
(entry-age (- current-time entry-time)))
|
|
(> entry-age threshold-seconds)))
|
|
|
|
(defun elfeed-prune (&optional dry-run)
|
|
"Prune the database entries.
|
|
|
|
Entries for which `elfeed-prune--elfeed-prune-entry-p' returns t are
|
|
removed from the database.
|
|
|
|
When DRY-RUN in non-nil, no actual pruning will be done, but the
|
|
number of items that would be removed will be shown in the echo
|
|
area."
|
|
(interactive "P")
|
|
(elfeed-db-ensure)
|
|
(let ((total-entries (hash-table-count elfeed-db-entries))
|
|
(removed-entries 0)
|
|
;; Make a copy so we don't iterate over a changing data structure
|
|
;; Also useful to gather stats in a dry run.
|
|
(elfeed-db-index-copy (avl-tree-copy elfeed-db-index))
|
|
(elfeed-db-entries-copy (copy-hash-table elfeed-db-entries)))
|
|
;; Remove entries
|
|
(with-elfeed-db-visit (entry feed)
|
|
(let ((prune-p (seq-some
|
|
(lambda (f) (funcall f entry feed))
|
|
elfeed-prune-predicates))
|
|
(keep-p (seq-some
|
|
(lambda (f) (funcall f entry feed))
|
|
elfeed-prune-keep-predicates)))
|
|
(when (and prune-p (not keep-p))
|
|
;; The `with-elfeed-db-visit' declares the variable `id' that
|
|
;; contains the entry ID.
|
|
(setq removed-entries (1+ removed-entries))
|
|
(avl-tree-delete elfeed-db-index-copy id)
|
|
(remhash id elfeed-db-entries-copy))))
|
|
(when (and
|
|
elfeed-prune-enabled
|
|
(not dry-run)
|
|
(< 0 removed-entries))
|
|
(setf (plist-get elfeed-db :index) elfeed-db-index-copy)
|
|
(setf elfeed-db-index (plist-get elfeed-db :index))
|
|
(setf (plist-get elfeed-db :entries) elfeed-db-entries-copy)
|
|
(setf elfeed-db-entries (plist-get elfeed-db :entries))
|
|
(elfeed-db-set-update-time)
|
|
(elfeed-db-save-safe)
|
|
(when elfeed-prune-gc
|
|
(elfeed-db-gc-safe)))
|
|
(if (or dry-run (not elfeed-prune-enabled))
|
|
(message "Would remove %d/%d elfeed entries [dry run]"
|
|
removed-entries
|
|
total-entries)
|
|
(message "Removed %d/%d elfeed entries"
|
|
removed-entries
|
|
total-entries))))
|
|
|
|
(provide 'elfeed-prune)
|
|
;;; elfeed-prune.el ends here
|